- دوشنبه ۲۵ آذر ۹۲
- ۱۹:۳۲
- ۰ نظر
در ادامه ...
Private Sub Command1_Click()
CreateShortcut "ادرس فایل برای شورت کات گرفتن", "BlackhatGH"
End Sub
Private Sub CreateShortcut(FilePath As String, ShortcutName As String)
Dim Filesys As New FileSystemObject
Dim WshShell As Object
Dim oShellLink As Object
Dim DesktopPath As String
Set WshShell = CreateObject("WScript.Shell")
DesktopPath = WshShell.SpecialFolders("Desktop")
Set oShellLink = WshShell.CreateShortcut(DesktopPath & "\" & ShortcutName & ".lnk")
If Filesys.FileExists(oShellLink) Then
MsgBox ("Already Exist")
Exit Sub
End If
oShellLink.TargetPath = FilePath
oShellLink.IconLocation = FilePath
oShellLink.WorkingDirectory = FilePath
oShellLink.Save
Set oShellLink = Nothing
Set WshShell = Nothing
End Sub