Introduction.
The CreateShortcut() method of the Windows Script Object can be used for creating Desktop Shortcuts in Microsoft Access. The Desktop Shortcut can launch frequently used Files like MS-Access, MS-Excel, MS-Word, Text Document, and others from the Desktop. This fact is known to all of us and nothing new. But, how do we do it from Access?
We have used the Popup() method of the Windows Script Object earlier for another Project. We have created a new Message Box in Microsoft Access that closes itself after a specified time. The Access MsgBox always requires the user to click on one of the displayed Buttons to close and continue with the Code execution. Hope you have already tried it out and started using it in your Projects.
The VBA ShortCut() Function Prototype.
The simple VBA Function Code that creates a Desktop Shortcut is given below for a quick look at it. All the required parameters are given as constants in the Function for clarity.
Public Function ShortCut() Dim objwshShell As Object Dim objShortcut As Object Set objwshShell = VBA.CreateObject("WScript.Shell") Set objShortcut = objwshShell.CreateShortCut("C:\Users\User\Desktop\Hello.txt.lnk") With objShortcut .TargetPath = "C:\Windows\Notepad.exe " .Arguments = "D:\Docs\Hello.txt" .WorkingDirectory = "D:\Docs" .Description = "Opens Hello.txt in Notepad" .HotKey = "Ctrl+Alt+9" .IconLocation = "C:\Windows\System32\Shell32.dll,130" .WindowStyle = 2 .Save End With End Function
You can create a Desktop Shortcut with the above VBA Code with a few changes on the highlighted portion of the Parameter Values.
- Replace the User with your own Windows User-Name.
- Create a Text File with some text in it and name the file Hello.txt.
- Save the File in one of your Folders.
- Change the File Path Name correctly in the. Arguments Value is shown highlighted.
- Change the Working Directory of your File in the next line.
- The rest of the Values can remain as they are.
The HotKey Ctrl+Alt+9 Keys Combination launches the Desktop Shortcut and opens the File for editing.
The Desktop Shortcut Icon.
In the IconLocation Parameter, check the number 130 at the end and it gives the required Desktop Icon. This Numeric Value Range is from 0 to 305 and gives different Icons for your Desktop Shortcut.
The Number 130 gives the following Icon Image:
- Right-Click on a Desktop Shortcut Icon and select the Properties from the displayed list.
- Click on the Change Icon Command Button on the Shortcut Tab.
- Select the required Icon, and click OK to close the Icon List.
- Click Apply Command Button to update the change.
Icon Images List.
It displays the Icon Images of about 76 columns of 4 Images each. To find a particular Icon’s number start counting from the left top items to the right and multiply the count by 4 and find the Icon’s Number. I could not find any other way to find the Icon Image number easier than the above method. Check the Image given below:
The DesktopShortcut() Function.
Now, we are ready for our VBA Function that can accept the minimum three required Parameters, which can be passed to the Function at Call time, and Create a Desktop Shortcut. The VBA Code is given below.
Option Compare Database Option Explicit Public Function DesktopShortCut(ByVal strShortCutName As String, _ ByVal strProgramPath As String, _ ByVal strFilePath As String, _ Optional strWorkDirectory As String = "", _ Optional ByVal strHotKey As String = "") As Boolean On Error GoTo DesktopShortCut_Err '----------------------------------------------------------------- 'Function: DesktopShortCut() 'Author: a.p.r. pillai 'Rights: All Rights(c) Reserved by www.msaccesstips.com 'Remarks: You may modify the Code, but need to keep these 'Rem lines intact. 'Parameters '----------------------------------------------------------------- '1. Shortcut Name: Shows below the Desktop Icon '2. strProgramPath: e.g.: "C:\Windows\System32\Notepad.exe" '3. strfilePath: File PathName to Open, e.g. "D:\Docs\Helloworld.txt" '4. Optional strWorkDirectory: e.g. "D:\Docs" '5. Optional strHotKey: Quick Launch - e.g. Ctl+Alt+9: 1-9,A-Z '----------------------------------------------------------------- Dim objwshShell As Object Dim objShortcut As Object Dim strPath As String Dim strProg As String, a As String, b As String Dim strTemp As String Dim DeskPath As String Dim strmsg As String Dim badchar As String, Flag As Boolean Dim j, count As Integer strPath = Environ("Path") 'Validation Checks GoSub IsValidName GoSub ValidateParams 'Find Current User Desktop strTemp = Mid(strPath, InStr(1, strPath, "C:\Users\"), 25) DeskPath = "C:\Users\" & Mid(strTemp, 10, InStr(10, strTemp, "\") - 10) & "\Desktop\" DeskPath = DeskPath & strShortCutName & ".Lnk" Set objwshShell = VBA.CreateObject("WScript.Shell") Set objShortcut = objwshShell.CreateShortCut(DeskPath) With objShortcut If InStr(1, Trim(strProgramPath), " ") > 0 Then .TargetPath = Chr(34) & Trim(strProgramPath) & Chr(34) '="C:\Windows\Notepad.exe" Else .TargetPath = Trim(strProgramPath) End If If InStr(1, Trim(strFilePath), " ") > 0 Then .Arguments = Chr(32) & Chr(34) & strFilePath & Chr(34) '="D:\Docs\Hello.txt" Else .Arguments = Chr(32) & strFilePath '="D:\Docs\Hello.txt" End If 'Optional Working Directory If Len(strWorkDirectory) > 0 Then .WorkingDirectory = strWorkDirectory '="D:\Docs" End If 'Optional Keyboard HotKey If Len(Nz(strHotKey, "")) > 0 Then .HotKey = "Ctrl+Alt+" & strHotKey '= "Ctrl+Alt+K" Else .HotKey = "" End If .IconLocation = "C:\Windows\System32\Shell32.dll,130" '0 - 305 .WindowStyle = 2 .Save End With DesktopShortCut = True DesktopShortCut_Exit: Exit Function IsValidName: Flag = True badchar = "\/:*?" & Chr(34) & "<>|" count = 0 For j = 1 To Len(strShortCutName) If InStr(1, badchar, Mid(strShortCutName, j, 1)) Then count = count + 1 End If Next Flag = IIf(count, False, True) If Not Flag Then MsgBox "Shortcut Name: " & strShortCutName & vbCr & vbCr _ & "Contains Invalid Characters." & vbCr & vbCr _ & "*** Program Aborted. ***", , "DeskShortCut()" DesktopShortCut = False Exit Function End If Return ValidateParams: strmsg = "" 'Program Path If Len(Nz(strProgramPath, "")) > 0 Then 'Check whether the Program exists in the given path If InStr(1, strProgramPath, Dir(strProgramPath)) = 0 Then strmsg = "Program Path: " & strProgramPath & " Invalid." End If Else strmsg = "Program Path: Not found!" End If 'File Path If Len(Nz(strFilePath, "")) > 0 Then If InStr(1, strFilePath, Dir(strFilePath)) = 0 Then If Len(strmsg) > 0 Then strmsg = strmsg & vbCr & "File Path: " & strFilePath & " Invalid." Else strmsg = "File Path: " & strFilePath & " Invalid." End If End If Else If Len(strmsg) > 0 Then strmsg = strmsg & vbCr & "File Path: Not found!" Else strmsg = "File Path: Not found!" End If End If If Len(strmsg) > 0 Then MsgBox strmsg, , "DeskShortCut()" DesktopShortCut = False Exit Function End If Return DesktopShortCut_Err: MsgBox Err & " : " & Err.Description, , "DesktopShortCut()" DesktopShortCut = False Resume DesktopShortCut_Exit End Function
The DesktopShortcut() Function is defined with five Parameters and the last two are Optional. The Working Directory and HotKey Parameter Values are optional.
We have added Validation checks on the passed parameter values and Error Trapp Lines to avoid crashes due to unexpected Errors and to exit from the Function gracefully.
Demo Run of the DesktopShortcut() Function.
The sample Run of the Function from the Immediate Window is given below:
Sample Run-1.
DesktopShortcut "HelloMyDB","C:\Program Files (x86)\Microsoft Office\Office12\MSACCESS.EXE","D:\New Folder\ClassDB.accdb"
Sample Run-2.
DesktopShortcut "HelloMyDoc","C:\Program Files (x86)\Microsoft Office\Office12\WINWORD.EXE","D:\Docs\TelNo2411808.docx","D:\Docs","T"
The TreeView Control Tutorial Session Links.
- Microsoft TreeView Control Tutorial
- Creating Access Menu with TreeView Control
- Assigning Images to TreeView Control
- Assigning Images to TreeView Control-2
- TreeView Control Check-Mark Add Delete Nodes
- TreeView ImageCombo Drop-Down Access Menu
- Re-arrange TreeView Nodes by Drag and Drop
- ListView Control with MS-Access TreeView
- ListView Control Drag Drop Events
- TreeView Control With Subforms