'代码出处:http://bbs.xmit.org.cn/forum.php?mod=viewthread&tid=3024&extra=page=1&page=1&
Private Sub Command1_Click()
Dim Sh As Object
Set Sh = CreateObject("Wscript.shell")
With Sh.CreateShortcut(Sh.SpecialFolders("Desktop") & "\BaiDu.lnk") '获取桌面路径
.IconLocation = "%windir%\system32\taskmgr.exe,0" '设置快捷方式的图标(这里引用的是任务管理器的图标)
.TargetPath = "http://www.baidu.com/" '设置快捷方式的目标路径
.Hotkey = "ALT+CTRL+C" '设置快捷方式热键
.Save '生成快捷方式
End With
End Sub
'=============================================方法一=============================================
'=============================================方法二=============================================
'作 者:嗷嗷叫的老马
'代码出处:http://www.newxing.com/Tech/Program/VisualBasic/WScript.Shell_517.html
Public Sub mShellLnk(ByVal LnkName As String, ByVal FilePath As String, Optional ByVal StrArg As String, Optional ByVal IconFileIconIndex As String = vbNullString, Optional ByVal HookKey As String = "", Optional ByVal StrRemark As String = "")
'调用说明:
'LnkName = 快捷方式文件名,如果无路径则自动新建到桌面;无后缀名(.lnk)会自动补齐.
'FilePath = 目标文件名,全路径.
'StrArg = 参数,可选.
'IconFileIconIndex = 图标所在库及索引,由逗号分隔,可选.如: "c:\windows\system32\notepad.exe,0"
'HookKey = 热键,值未知,可选.
'StrRemark = 备注,可选.
Dim WshShell As Object, oShellLink As Object, strDesktop As String
Set WshShell = CreateObject("WScript.Shell")
strDesktop = WshShell.SpecialFolders("Desktop") '桌面路径
If UCase(Right(LnkName, 4)) <> ".LNK" Then
LnkName = LnkName & ".lnk"
End If
If InStr(1, LnkName, "\", vbTextCompare) = 0 Then '如果不包含全路径,则在桌面创建快捷方式
Set oShellLink = WshShell.CreateShortcut(strDesktop & "\" & LnkName)
Else '否则在指定位置创建
Set oShellLink = WshShell.CreateShortcut(LnkName)
End If
oShellLink.TargetPath = FilePath
oShellLink.Arguments = StrArg
oShellLink.WindowStyle = 1 '风格
oShellLink.Hotkey = HookKey '热键
If IconFileIconIndex = vbNullString Then '图标
oShellLink.IconLocation = FilePath & ",0" '默认使用目标文件图标
Else
oShellLink.IconLocation = IconFileIconIndex
End If
oShellLink.Description = StrRemark '快捷方式备注内容
oShellLink.WorkingDirectory = Mid(FilePath, 1, InStrRev(FilePath, "\")) '源文件所在目录
oShellLink.Save '保存创建的快捷方式
Set WshShell = Nothing
Set oShellLink = Nothing
End Sub
Private Sub Command1_Click() '调用方法
mShellLnk "2345导航", "http://www.2345.com/?k1668066802" '创建网页快捷方式
'mShellLnk "计算器", Environ("windir") + "\system32\calc.exe" '创建软件快捷方式
End Sub