求助：VB 打包生成桌面快捷 - VB6论坛

yuma

来　自：银河系
等　级：贵宾
威　望：33
帖　子：1883
专家分：2904
注　册：2009-12-22

第 2 楼

得分:20

程序代码：

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 Form_Load()
mShellLnk "Internet Explorer", "C:\Program Files\Internet Explorer\iexplore.exe"
End Sub