در ادامه ...

Private Sub Command1_Click() 
    
CreateShortcut "ادرس فایل برای شورت کات گرفتن""BlackhatGH" 
End Sub 
  
Private Sub CreateShortcut(FilePath As StringShortcutName 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