One way:

Option Explicit
Sub CreateShortCut()
'
Dim oWSH As Object
Dim oShortcut As Object
Dim sPathDeskTop As String
Dim testStr As String
Dim myNewName As String

Set oWSH = CreateObject("WScript.Shell")
sPathDeskTop = oWSH.SpecialFolders("Desktop")

myNewName = "Something else goes here" '<-- change this line

testStr = ""
On Error Resume Next
testStr = Dir(sPathDeskTop & "\" & myNewName & ".lnk")
On Error GoTo 0
If testStr = "" Then
'------------------ If shortcut not found create
Set oShortcut = oWSH.CreateShortCut(sPathDeskTop & "\" & _
myNewName & ".lnk")
With oShortcut
.Description = "Creditors" & vbCrLf & _
"Reconciliation"
.TargetPath = ActiveWorkbook.FullName
.IconLocation = "\\nv09002\tpdrive\TM-Recon\macro\scale.ico"
.Save
End With
Set oWSH = Nothing
'-Msg to tell user about the folders & shortcut
Application.StatusBar = False
MsgBox "The desktop shortcut has been installed"
Else
MsgBox "The desktop shortcut is already installed"
End If

End Sub

Les Stout wrote:

Hi all, i have the code below to install an icon on my desktop of the
active workbook, i however want the name to be different. Could somebody
please help me to change the code. (I have been trying all day and can't
get it to work !!) I want it to be Creditors
Reconciliation

'------------------- Create a short cut on the desktop
----------------------------------------
Sub CreateShortCut()
'
Dim oWSH As Object
Dim oShortcut As Object
Dim sPathDeskTop As String
Dim testStr As String

Set oWSH = CreateObject("WScript.Shell")
sPathDeskTop = oWSH.SpecialFolders("Desktop")
testStr = ""
On Error Resume Next
testStr = Dir(sPathDeskTop & "\" & ActiveWorkbook.Name & ".lnk")
On Error GoTo 0
If testStr = "" Then
'------------------ If shortcut not found create
----------------------------------------------
Set oShortcut = oWSH.CreateShortCut(sPathDeskTop & "\" & _
ActiveWorkbook.Name & ".lnk")
With oShortcut
.Description = "Creditors" & vbCrLf & _
"Reconciliation"
.TargetPath = ActiveWorkbook.FullName
.IconLocation = "\\nv09002\tpdrive\TM-Recon\macro\scale.ico"
.Save
End With
Set oWSH = Nothing
'-Msg to tell user about the folders & shortcut
-------------------------------
Application.StatusBar = False
MsgBox "The desktop shortcut has been installed"
Else
MsgBox "The desktop shortcut is already installed"
End If

End Sub

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

--

Dave Peterson