Create Desktop Shortcut
acCmdCreateShortcut
This procedure creates a desktop shortcut to an object within the database. Unfortunately it does use SendKeys and there is bit of screen flashing but it works.
'***************** Code Start *******************
' This code was originally written by Terry Wickenden.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
Sub NewShortCut(strName As String, Optional strObject _
As String = "Form", Optional strShortcut As String)
' Accepts: strName - name of object
' strObject - type of object
' strShortCut - shortcut to use
' strObject - optional - defaults to Form
' strObject - valid values - Table, Form, Query, Report, Macro, Module
Dim intType As Integer
Dim strMsg As String
On Error GoTo ErrNewShortCut
Select Case strObject
Case "Form"
intType = acForm
Case "Report"
intType = acReport
Case "Query"
intType = acQuery
Case "Table"
intType = acTable
Case "Module"
intType = acModule
Case "Macro"
intType = acMacro
Case Else
MsgBox "Invalid object type", vbCritical, "Entry Error"
Exit Sub
End Select
'select the object in the database window
DoCmd.SelectObject intType, strName, True
'create the shortcut message and file name
If IsMissing(strShortcut) Then
strShortcut = "Shortcut to " & strName
End If
strShortcut = "C:\WINDOWS\DESKTOP\" & strShortcut & ".maf"
'create the shortcut
SendKeys strShortcut, False
SendKeys "~", False
DoCmd.RunCommand acCmdCreateShortcut
Exit Sub
ErrNewShortCut:
Select Case Err
Case 2501
'Cancel selected by user in a dialog
Exit Sub
Case 2544
'Invalid object name
strMsg = "There is no " & strObject & " called " & strName & "."
MsgBox strMsg, vbCritical, "Entry Error"
Exit Sub
Case Else
MsgBox Err & vbCrLf & vbCrLf & Err.Description, vbCritical, "Error Message"
Exit Sub
End Select
End Sub
'****************** Code End ********************