Create Desktop Shortcut - Change Icon

[craigos]

Hi All,

I am using code which I got from this forum by Justin Labenne - code below my query.

In the description from the link I used it states:

'Uses an Icon file for a shortcut in place of the standard "Workbook" icon. The example provided contains an Excel file, and an .ico (icon) file'

Works excellent however I want it to show as Workbook Icon on Desktop.

Can anyone tell me what I need to change in the code to get that or is there some other code that I can use.

[vba]Option Explicit

Sub CreateDesktopShortcut()

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

szMsg = "You need only do this once" _
& vbNewLine & "" _
& vbNewLine & "or if the shortcut is missing in the future"
szStyle = 0
szTitle = "Take Note!"
MsgBox szMsg, szStyle, szTitle

' Change here for the icon's name
Const szIconName As String = "\Gpao.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" _
& vbNewLine & "" _
& vbNewLine & " This file will now close" _
& vbNewLine & "" _
& vbNewLine & "The Desktop will then show, so you can check it works"
szStyle = 0
szTitle = "Success!"
MsgBox szMsg, szStyle, szTitle

CreateObject("shell.application").minimizeall

ThisWorkbook.Close Savechanges:=True
Exit Sub

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

MsgBox szMsg, szStyle, szTitle
End Sub

[/vba]
Thanks

Craig

[Kenneth Hobs]

Do you mean that you want the default icon? If you don't want the default then you need to use the ico file. There are ico extractors at sites like download.com. Extract the ico files from Excel.exe.

[craigos]

Thanks Kenneth.....with the response you gave I re-read the code and found what NOT to include.

And thanks for download.com

Craig