在任意文件夹创建快捷方式的代码

我们知道，利用WSH技术（Windows Scripting Host），在系统的特殊文件夹可以创建应用程序的快捷方式。这些特殊文件夹是指：Desktop（桌面）、Start Menu（开始菜单）、MyDocuments（我的文档），等等。在网上搜索到的例子，都是将系统自带的记事本或计算器，在这些特殊文件夹中创建快捷方式。其实，WSH技术可以在任意文件夹为任意文件创建快捷方式。下面是可以在VB环境中运行的源代码。

Option Explicit

Private Sub Command1_Click()
Dim Dlg As Object, FilePath As String, lnkName As String, specialName As String, k As Integer
Set Dlg = CreateObject("MSComDlg.CommonDialog")

With Dlg
  .DialogTitle = "选择一个文件"
  .Flags = &H200C
  .Filter = "要创建快捷方式的源文件|*.*"
  .ShowOpen
  FilePath = .FileName
End With
If Len(FilePath) < 5 Then Exit Sub

specialName = "请选择存放快捷方式的文件夹" & vbCrLf & vbCrLf & "1所有用户开始菜单" & vbCrLf & _
"2所有用户程序" & vbCrLf & "3所有用户桌面" & vbCrLf & "4所有用户启动" & vbCrLf & _
"5当前用户开始菜单" & vbCrLf & "6当前用户程序" & vbCrLf & "7当前用户桌面" & vbCrLf & _
"8当前用户启动" & vbCrLf & "9任意文件夹" & vbCrLf & vbCrLf & "请选择(1—9)："

k = Val(InputBox(specialName, "快捷方式存放文件夹", 7))
If k < 1 Or k > 9 Then Exit Sub
lnkName = Dir(FilePath): lnkName = Left(lnkName, InStrRev(lnkName, ".") - 1)

If k = 9 Then
  With Dlg
    .DialogTitle = "选择保存快捷方式的文件夹"
    .Flags = &H200A
    .Filter = "保存为快捷方式"
    .FileName = lnkName
    .Showsave
    specialName = .FileName
  End With
  If specialName = lnkName Then Exit Sub
  specialName = Left(specialName, InStrRev(specialName, "\") - 1) '去掉文件名
Else
  Select Case k
    Case 1: specialName = "AllUsersStartMenu"
    Case 2: specialName = "AllUsersPrograms"
    Case 3: specialName = "AllUsersDesktop"
    Case 4: specialName = "AllUsersStartup"
    Case 5: specialName = "StartMenu"
    Case 6: specialName = "Programs"
    Case 7: specialName = "Desktop"
    Case 8: specialName = "Startup"
  End Select
End If

Dim WSHShell, MyShortcut, specialFolder
Set WSHShell = CreateObject("WScript.Shell")
specialFolder = IIf(k = 9, specialName, WSHShell.SpecialFolders(specialName))    '创建快捷方式路径
Set MyShortcut = WSHShell.CreateShortcut(specialFolder & "\" & lnkName & ".lnk") '设置快捷方式路径及名称
MyShortcut.TargetPath = FilePath            '设置源文件全路径文件名
MyShortcut.WorkingDirectory = specialFolder '设置存放快捷方式的文件夹
MyShortcut.IconLocation = FilePath & ",0"   '设置快捷方式图标
MyShortcut.Save
MsgBox "快捷方式已创建在指定文件夹"
End Sub


本代码在win7旗舰版通过，未在其它版本测试。