Create Desktop Shortcut

'***************** 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 ********************