Code:
Private Sub Command6_Click()
Dim ShortcutPath As String
Dim FileSname As String
FileSname = Left(CurrentProject.Name, InStr(CurrentProject.Name, ".") - 1)
ShortcutPath = CurrentProject.Path & "\" & FileSname & " - Shortcut.lnk"
With VBA.CreateObject("WScript.Shell").CreateShortCut(ShortcutPath)
.TargetPath = CurrentProject.Path & "\" & CurrentProject.Name
.WorkingDirectory = CurrentProject.Path
.Description = "Shortcut"
.IconLocation = CurrentProject.Path & "\" & "mydraw.ico"
.WindowStyle = 7
.Save
End With
End Sub