davidam
asked on
Create a desktop shortcut to an Excel file
Does anyone know how to use VBA to create a desktop[ shortcut to a specifice Excel file.
(There is a discussion about this in the knowledge base but the link is broken.) Thanks.
(There is a discussion about this in the knowledge base but the link is broken.) Thanks.
http://vbnet.mvps.org/index.html?code/shell/shshortcutcheat.htm
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
All of these look quite promising, but I cannot figure out how to make them work. I would like to post some code and ask if anyone could adapt it to point to say a file called "Input.xls" in the C directory. I just do not know what to change on these:
' and an even simpler one from skrga
Dim sShortcutPath As String, sExtension As String
Dim fs As New FileSystemObject
Dim oShell As New WshShell
sShortcutPath = InputBox("Enter path and filename of link file: ")
If sShortcutPath <> "" Then
sExtension = fs.GetExtensionName(sShortcutPath)
Select Case sExtension
Case "lnk"
Dim oShortcut As WshShortcut
Set oShortcut = oShell.CreateShortcut(sShortcutPath)
Case "url"
Dim oURLShortcut As WshURLShortcut
Set oURLShortcut = oShell.CreateShortcut(sShortcutPath)
Case Else
' user input an invalid path or filename; display an error and
' exit
Exit Sub
End Select
End If
' a nice simple one from skrga
Dim WSHShell As Object
Set WSHShell = CreateObject("WScript.Shell")
Dim MyShortcut As Object
Dim DesktopPath As String
' Read desktop path using WshSpecialFolders object
DesktopPath = WSHShell.SpecialFolders("Desktop")
' Create a shortcut object on the desktop
Set MyShortcut = WSHShell.CreateShortcut(DesktopPath & _
"\notepad_999.lnk")
' Set shortcut object properties and save it
MyShortcut.TargetPath = WSHShell.ExpandEnvironmentStrings("%windir%\notepa d.exe")
MyShortcut.WorkingDirectory = WSHShell.ExpandEnvironmentStrings("%windir%")
MyShortcut.WindowStyle = 4
MyShortcut.IconLocation = _
WSHShell.ExpandEnvironmentStrings("%windir%\notepa d.exe, 0")
MyShortcut.Save
' A nice simple one from skrga
Set MyShortcut = Nothing
Set WSHShell = Nothing
'From jppinto and skrga
Option Explicit
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 = "\cvg.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
The code from the link I provided is to be run from an Excel sheet and will make a shortcut with the link to that file.
ASKER
I figured as much but all I got was the ErrHandle msg. I saved the file and gave it a name and got the same result. Any suggestions?
ASKER
Further to previous comment to jppinto...sorry it does work. I would like to know how to adapt it to point to a file other than this workbook.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
P.S. This solution worked at my pc (with reference checked)
Dim WSHShell As Object
Set WSHShell = CreateObject("WScript.Shel l")
Dim MyShortcut As Object
Dim DesktopPath As String
' Read desktop path using WshSpecialFolders object
DesktopPath = WSHShell.SpecialFolders("D esktop")
' Create a shortcut object on the desktop
Set MyShortcut = WSHShell.CreateShortcut(De sktopPath & _
"\TEST.lnk")
' Set shortcut object properties and save it
MyShortcut.TargetPath = WSHShell.ExpandEnvironment Strings("D :\test.pdf ") 'Path to file
MyShortcut.WorkingDirector y = WSHShell.ExpandEnvironment Strings("D :\") ' path to working directory
MyShortcut.WindowStyle = 4
'MyShortcut.IconLocation = 'WSHShell.ExpandEnvironmen tStrings(" %windir%\n otepa d.exe, 0") 'you can uncomment this and set icon for shortcut
MyShortcut.Save
Set MyShortcut = Nothing
Set WSHShell = Nothing
Dim WSHShell As Object
Set WSHShell = CreateObject("WScript.Shel
Dim MyShortcut As Object
Dim DesktopPath As String
' Read desktop path using WshSpecialFolders object
DesktopPath = WSHShell.SpecialFolders("D
' Create a shortcut object on the desktop
Set MyShortcut = WSHShell.CreateShortcut(De
"\TEST.lnk")
' Set shortcut object properties and save it
MyShortcut.TargetPath = WSHShell.ExpandEnvironment
MyShortcut.WorkingDirector
MyShortcut.WindowStyle = 4
'MyShortcut.IconLocation = 'WSHShell.ExpandEnvironmen
MyShortcut.Save
Set MyShortcut = Nothing
Set WSHShell = Nothing
ASKER
I actually was able to adapt one of skrga's solutions and ppinto's works as well. Thanks to all; brilliant stuff!