Place Shortcut On Desktop

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I have the following code to save the current file in the existing folder
wherever that may be. :

'Save file with new name in existing path
sPathName = ActiveWorkbook.Path & "\"
sFileName = Range("File_SaveAs_Date_Sheet1").Value
sFileNamePath = sPathName & sFileName
ActiveWorkbook.SaveAs sFileNamePath

What I would like to be able to do is send a shortcut to the desktop for
easy access to this file. Ideally the shortcut would contain the file name,
as provided by sFileName = Range("File_SaveAs_Date_Sheet1").Value.

As a one off I can manually enter the path to desktop, but ideally this
would be obtained by the macro.

Many Thanks

Paul Moles
 
Here is some code


Sub CreateShortCut()
Dim oWSH As Object
Dim oShortcut As Object
Dim sPathDeskTop As String

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

Set oShortcut = oWSH.CreateShortCut(sPathDeskTop & "\" & _
ActiveWorkbook.Name & ".lnk")
With oShortcut
.TargetPath = ActiveWorkbook.FullName
.Save
End With
Set oWSH = Nothing

End Sub
 
Hello Paul
Here's one way (please amend accordingly - I have included your filename
variable)
Dim wsh As Object
Dim SC As Object
Dim DesktopPath As String
Set wsh = CreateObject("WScript.Shell")
DesktopPath = wsh.SpecialFolders.Item("Desktop")
Set SC = wsh.CreateShortcut(DesktopPath & "\test.lnk")
SC.TargetPath = sFileNamePath
SC.Icon = "d:\My Documents\phone3.ico"
SC.Hotkey = "CTRL+ALT+Z"
SC.Save
Set wsh = Nothing
Set SC = Nothing

HTH
Cordially
Pascal
 
Back
Top