Creating shortcut to folder

rogerm

Board Regular
Joined
May 12, 2002
Messages
53
I am using the vba code below to create desktop shortcuts to workbooks.
Could anyone help me with the code to to create a shortcut to open a the folder containing the workbooks rather than the workbook itself. Thanks

Function fCreateShortcutOnDesktop(strFullFilePathName As String) _
As Long


Dim WSHShell As IWshRuntimeLibrary.IWshShell_Class
Dim WSHShortcut As IWshRuntimeLibrary.IWshShortcut_Class
Dim strDesktopPath As String
Dim strFileName As String
Dim strPath As String

On Error GoTo fCreateShortcutOnDesktop_Err

' Create a Windows Shell Object
Set WSHShell = New IWshRuntimeLibrary.IWshShell_Class

' Get the file's name and path...
strFileName = Dir(strFullFilePathName)
strPath = Left(strFullFilePathName, _
Len(strFullFilePathName) - Len(strFileName))

' Make sure file exists
If Not Len(strFileName) = 0 Then

' Read desktop path using WshSpecialFolders object
strDesktopPath = WSHShell.SpecialFolders.Item("Desktop")

' Create a shortcut object on the desktop
Set WSHShortcut = WSHShell.CreateShortcut _
(strDesktopPath & "\" & strFileName & ".lnk")

' Set shortcut object properties and save it
With WSHShortcut
.TargetPath = WSHShell. _
ExpandEnvironmentStrings(strFullFilePathName)
.WorkingDirectory = WSHShell. _
ExpandEnvironmentStrings(strPath)
.WindowStyle = 4
.IconLocation = WSHShell. _
ExpandEnvironmentStrings(Application.Path _
& "\excel.exe ,0")
.Save
End With
fCreateShortcutOnDesktop = 1
Else
fCreateShortcutOnDesktop = 0
End If
Continue:
' Tidy Up
Set WSHShell = Nothing
Exit Function

fCreateShortcutOnDesktop_Err:
fCreateShortcutOnDesktop = -1
Resume Continue
End Function
 

Some videos you may like

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

Watch MrExcel Video

Forum statistics

Threads
1,127,554
Messages
5,625,471
Members
416,108
Latest member
Ravenhold

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top