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

已结贴√ 问题点数：20 回复次数：4

求助：VB 打包生成桌面快捷

VB6 打开生成包，安装时有生成桌面快捷提示，但桌面并没生成快捷方式。求帮看一下，不胜感激。

        If MsgBox("是否要创建桌面快捷方式？ ", 32 + 4, "创建桌面快捷方式") = vbYes Then
        OSfCreateShellLink "../../Desktop", InkName, InkPath, "", True, "$(Programs)"
        OSfCreateShellLink "../../桌面", InkName, InkPath, "", True, "$(Programs)"
        End If

[此贴子已经被作者于2022-10-8 14:58编辑过]

搜索更多相关主题的帖子: 桌面　生成　 VB　VB　生成　打包　创建　创建　打包　桌面　

第 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