Help Creating a Custom Desktop Shortcut

[dravosa]

Hi all:

Im using Justinlabenne code to Create a Custom Desktop Shortcut


Option Explicit

Sub CreateDesktopShortcut()
' =================================================================
' Create a custom icon shortcut on the users desktop
' =================================================================

' Msgbox string variables
Dim szMsg As String
Dim szStyle As String
Dim szTitle As String


' Change here for the icon's name
Const szIconName As String = "\cvg.ico"


' Constant string values, you can replace "Desktop"
' with any Special Folders name to create the shortcut there
Const szlocation As String = "Desktop"
Const szLinkExt As String = ".lnk"


' Object variables
Dim oWsh As Object
Dim oShortcut As Object


' String variables
Dim szSep As String
Dim szBookName As String
Dim szBookFullName As String
Dim szPath As String
Dim szDesktopPath As String
Dim szShortcut As String


' Initialize variables
szSep = Application.PathSeparator
szBookName = szSep & ThisWorkbook.Name
szBookFullName = ThisWorkbook.FullName
szPath = ThisWorkbook.Path



On Error GoTo ErrHandle
' The WScript.Shell object provides functions to read system
' information and environment variables, work with the registry
' and manage shortcuts
Set oWsh = CreateObject("WScript.Shell")
szDesktopPath = oWsh.SpecialFolders(szlocation)


' Get the path where the shortcut will be located
szShortcut = szDesktopPath & szBookName & szLinkExt


' Make it happen
Set oShortcut = oWsh.CreateShortCut(szShortcut)


' Link it to this file
With oShortcut
.TargetPath = szBookFullName
.IconLocation = szPath & szIconName
.Save
End With


' Explicitly clear memory
Set oWsh = Nothing
Set oShortcut = Nothing


' Let the user know it was created ok
szMsg = "Shortcut was created successfully"
szStyle = 0
szTitle = "Success!"
MsgBox szMsg, szStyle, szTitle


Exit Sub


' or if it wasn't
ErrHandle:
szMsg = "Shortcut could not be created"
szStyle = 48
szTitle = "Error!"

MsgBox szMsg, szStyle, szTitle
End Sub






Works great, Thanks very much. but I was wonder if there is some way to include the icon file inside the spreadsheet to avoid the need of have it always on the same folder.
In order to be able to work as stand alone file.

Thanks a lot.


Carlos.