如何用VB给指定文件创建桌面快捷方式

2025-02-27 07:24:06

推荐回答（4个）

回答1：

vb创建快捷方式有以下几种方法：
1、用fCreateShellLink函数，此方法用户电脑必须有STKIT432.DLL文件。
Private Declare Function fCreateShellLink Lib "STKIT432.DLL" (ByVal lpstrFolderName AsString, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long Sub
private Command1_Click()
Dim lReturn As Long
lReturn = fCreateShellLink("..\..\Desktop", "Shortcut to Calculator", "c:\windows\calc.exe", "")
End Sub
2、比较常用的是用WshShell对象创建快捷方式，此方法依赖\system32\WSHom.Ocx文件，部分电脑可能关闭了此文件权限，所以用的时候可根据错误，自动注册该组件
Dim nPath As String, sh, ShortCut
on error resume next
Set sh = CreateObject("wscript.shell")
If Err = 429 Then'判断用户电脑是否禁用了WshShell，如果禁用重新注册这个组件
Dim oca As String
oca = Environ("Windir") & "\system32\WSHom.Ocx"
If Dir(oca) = "" Then Exit Function
Shell "regsvr32 """ & oca & """ /s"
Err = 0
Set sh = CreateObject("wscript.shell")
End If
nPath = sh.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Desktop")'获取当前用户的桌面目录
If Right(nPath, 1) <> "" Then nPath = nPath & "\"
ShortF = nPath & "文本文档.lnk"
Set ShortCut = sh.CreateShortcut(ShortF) '开始创建快捷方式对象
ShortCut.TargetPath = "C:\123.exe" '快捷方式指向的目标文件，写完整路径
ShortCut.Save
3、自己写快捷方式创建控件。此方法代码比较繁琐，网上也有相关实例代码，也是可以参考的一种方式。

回答2：

创建快捷方式-例子
Dim nPath As String, sh, ShortCut

'获取当前用户的桌面目录
Set sh = CreateObject("wscript.shell")
nPath = sh.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Desktop")
If Right(nPath, 1) <> "" Then nPath = nPath & "\"

ShortF = nPath & "文本文档.lnk"'快捷方式名称
Set ShortCut = sh.CreateShortcut(ShortF) '创建一个快捷方式对象
ShortCut.TargetPath = "C:\a.txt" '快捷方式指向的目标，可以是任意文件
ShortCut.Save '保存快捷方式

回答3：

Private Declare Function OSfCreateShellLink Lib "vb6stkit.dll" Alias "fCreateShellLink" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArguments As String, ByVal fPrivate As Long, ByVal sParent As String) As Long

Public Function CreatLinkAtDesktop(strName As String, strFile As String, Optional strPro As String) As Boolean
CreatLinkAtDesktop = True
Dim lReturn As Long
'win2000下
lReturn = OSfCreateShellLink("..\..\桌面", strUnQuoteString(strName), strUnQuoteString(strFile), strPro & vbNullChar, True, "$(Programs)")
If lReturn Then Exit Function
'win98下
lReturn = OSfCreateShellLink("..\..\Desktop", strUnQuoteString(strName), strUnQuoteString(strFile), strPro & vbNullChar, True, "$(Programs)")
If lReturn Then Exit Function
CreatLinkAtDesktop = False
End Function
Public Function strUnQuoteString(ByVal strQuotedString As String)
'
' This routine tests to see if strQuotedString is wrapped in quotation
' marks, and, if so, remove them.
'
strQuotedString = Trim(strQuotedString)

If Mid$(strQuotedString, 1, 1) = gstrQUOTE And Right$(strQuotedString, 1) = gstrQUOTE Then
'
' It's quoted. Get rid of the quotes.
'
strQuotedString = Mid$(strQuotedString, 2, Len(strQuotedString) - 2)
End If
strUnQuoteString = strQuotedString
End Function

Private Sub Command1_Click()
'CreatLinkAtDesktop "notepad.exe", "c:\Windows\system32\notepad.exe"
CreatLinkAtDesktop "娱乐程序.exe ", "写娱乐程序.exe所在的文件全路径"
End Sub

回答4：

用API函数：
fcreatshelllink

最新问答

用雅虎邮箱写信的时候，有一个“收件人”和“抄送”。“抄送”是什么意思

我总是沉浸在后悔自责中，严重影响我的生活，我该怎么办啊