create shortcuts

[Jaye7]

I am trying to use the following script to create hundreds of shortcuts.

However I am getting a runtime error 5, invalid procedure

If I remove the TargetName from the line that errors and use "X:\Master Front Ends\TheBrain JT.mdb" it creates shortcuts, but obviously they would all have the same shortcut target/path which is not what I want

The target path is correct as when it places the TargetName code into the form textbox it matches a shortcut that I manually created and if I copy the code into a shortcut it works.

The path must be what I have stated as it is run from a terminal server and when we first set up a user we have to specify the msaccess.exe and work group join script and we find that when we have drop outs quite often users have to join the work group again, whereas when we use it in the path it automatically joins the group.

I am currently doing this in MS ACCESS, however once working, I will also use it in excel with a couple of minor tweaks.

I also posted the same question on the following.
Create Shortcuts - Access World Forums

Sub Create_Shortcuts()

' Requires a reference to the Windows Script Host Object model
     
    Dim objWSH As IWshRuntimeLibrary.WshShell
    Dim objShortCut As IWshRuntimeLibrary.WshShortcut
    Dim strPath  As String
    Dim strShortcutPath As String
    Dim strShortcutName As String
    Dim strShortcutToFile As String

Dim YesNoCancel As VbMsgBoxResult

YesNoCancel = MsgBox("This code MUST be run from the terminal server, NOT from your PC ... Do you want to continue?", vbYesNoCancel + vbCritical, "Caution")
Select Case YesNoCancel

Case vbYes
GoTo StartScript1
Case vbNo
Exit Sub
Case vbCancel
Exit Sub
End Select


StartScript1:

If IsNull(Me.txtCopyDbase) Or Me.txtCopyDbase = "" Then
DoCmd.OpenForm "GeneralMessageBox"
Forms!GeneralMessageBox.lbCaption.Caption = vbNewLine & "You must select a database first"
Exit Sub
End If

Dim NewFileName As String, TargetName As String

'==================================================================================================
'Create shortcut loop based on initials/names in form listbox

Dim lngRow As Long
    Dim strMsg As String

    With Forms![F DB - switchboard]!EmpInitials
        For lngRow = 0 To .ListCount - 1
        
If Me.txtCopyDbase = "Brain" Then
NewFileName = "TheBrain " & .Column(0, lngRow) & ".lnk"
TargetName = """C:\Program Files (x86)\Microsoft Office\Office14\MSACCESS.EXE""" & " " & """X:\FrontEnds\User Databases\TheBrain " & .Column(0, lngRow) & ".mdb""" & " /wrkgrp " & """X:\KLIKTUBE.mdw"""
End If
        
        
'On Error GoTo Err2


' location to create shortcut in
    strShortcutPath = "X:\Master Front Ends\"
    
' name of shortcut
    strShortcutName = NewFileName
     
    Set objWSH = New IWshRuntimeLibrary.WshShell
    Set objShortCut = objWSH.CreateShortcut(strShortcutPath & strShortcutName)
    
'put link path into form textbox to make sure it is correct
    Me.txtlink = strShortcutToFile
    
'shortcut target path to file
    Me.txtlink = TargetName
  [B][COLOR=Red]  objShortCut.TargetPath = TargetName '"X:\Master Front Ends\TheBrain JT.mdb"[/COLOR][/B]
    'objShortCut.IconLocation = "C:\Program Files\Microsoft Office\Office12\MSN.ICO"
   
    objShortCut.Save
            
        Next lngRow
    End With
    
'==================================================================================================

    Set objShortCut = Nothing
    Set objWSH = Nothing
    
DoCmd.OpenForm "GeneralMessageBox"
Forms!GeneralMessageBox.lbCaption.Caption = vbNewLine & "Shortcuts created" & vbNewLine & ErrMessage
Exit Sub

Err1:
If Err = 70 Then
ErrMessage = ErrMessage & vbNewLine & fileName
Resume Next
End If

Err2:
If Err = 70 Then
DoCmd.OpenForm "GeneralMessageBox"
Forms!GeneralMessageBox.lbCaption.Caption = vbNewLine & "Either the database you are copying is open" & vbNewLine & "OR the existing file that you are replacing is open"
Exit Sub
End If
End Sub