Use icon from network drive for desktop shortcut

[jhize]

Currently using this code. It creates a shortcut for the workbook on the desktop. I'd like to use an .ico file for this shortcut. This file is in the same folder on a network drive. The shortcut does not take this icon. Any ideas?

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 = "redlist.ico"
' --------------------------
' This is the network location
' Const szIconName As String = "\\ellwp0167dm4\dub2kfil002\LCI\Huizer\redlist.ico (file://ellwp0167dm4/dub2kfil002/LCI/Huizer/redlist.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

[shasur]

Are you sure that the icon file is located in the same directory of the Workbook szPath?

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


Curious to check if some problem exists with the path separator. Try to add the following code before Linking it to the file

If Right$(szPath, 1) <> "\" Then szPath = szPath & "\"

that is

If Right$(szPath, 1) <> "\" Then szPath = szPath & "\"

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

[jhize]

Unfortunately, that did not work. No problem with path seperator. Any other possible solutions?