T3789_Create Workbook Shortcut To Desktop IconLocation

https://excel-egy.com/forum/t3789
---------------------------------

Sub Create_Workbook_Shortcut_To_Desktop_Specify_IconLocation()
    Dim oWSH            As Object
    Dim oShortcut       As Object

    Set oWSH = CreateObject("WScript.Shell")
    Set oShortcut = oWSH.CreateShortCut(oWSH.SpecialFolders("Desktop") & "\" & ThisWorkbook.Name & ".lnk")

    With oShortcut
        .TargetPath = ThisWorkbook.FullName
        .IconLocation = ThisWorkbook.Path & "\3ds max.ico"
        .Save
    End With
    Set oWSH = Nothing
End Sub