利用VBS創建快捷方式

Private Sub CmdRecFind_Click()
Dim lnkPath As String, lnkName As String, ExePath As String, Ts As String
Dim i As Integer
 
  lnkName = "TSAPP"
  lnkPath = GetDirs("desktop") & "\"
  ExePath = CStr(SysCmd(acSysCmdAccessDir)) & "MSAccess.EXE"
 
  Open lnkPath & "tmp.vbs" For Output As #1
      Print #1, "Dim WSHShell,oShellLink"
      Print #1, "Set WSHShell = WScript.CreateObject(" & Chr(34) & "WScript.Shell" & Chr(34) & ")"
      Print #1, "Set oShellLink = WSHShell.CreateShortCut(" & Chr(34) & lnkPath & lnkName & ".lnk" & Chr(34) & ")"
      Print #1, "oShellLink.TargetPath =" & Chr(34) & ExePath & Chr(34)
      Print #1, "oShellLink.Arguments=""""""" & CurrentProject.FullName & """"""""
      Print #1, "oShellLink.WorkingDirectory=" & Chr(34) & CStr(SysCmd(acSysCmdAccessDir)) & Chr(34)
      Print #1, "oShellLink.Save"
  Close #1
  If Shell("wscript """ & lnkPath & "tmp.vbs""") <> 0 Then
  Call SleepEx(3000, 0)
  FileSystem.Kill lnkPath & "tmp.vbs"
  End If
End Sub