Desktop icon name

[Les Stout]

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]

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

 

[Gary''s Student]

Near the start of your code include:

newname = Application.InputBox("Enter desired shortcut name:", Type:=2)

And then in place of:

ActiveWorkbook.Name & ".lnk"

use

newname & ".lnk")

throughout

 

[Les Stout]

Thanks Dave, will give it a try...

Les Stout

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

 

[Les Stout]

Thanks Gary's Student

Les Stout

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