Create Shortcuts

Jaye7

Registered User.
Local time
Today, 20:30
Joined
Aug 19, 2014
Messages
205
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.

Code:
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
 
is TargetName a control on a form? or a field from a table? if so try [TargetName]
 
TargetName is a string within the script and it doesn't work either.

Code:
TargetName = """C:\Program Files (x86)\Microsoft Office\Office14\MSACCESS.EXE""" & " " & """X:\FrontEnds\User Databases\TheBrain " & .Column(0, lngRow) & ".mdb""" & " /wrkgrp " & """X:\KLIKTUBE.mdw"""
 
TargetName = "C:\Program Files (x86)\Microsoft Office\Office14\MSACCESS.EXE X:\FrontEnds\User Databases\TheBrain " & .Column(0, lngRow) & ".mdb /wrkgrp X:\KLIKTUBE.mdw"
 
Thanks but it actually needs all of those quotes for the shortcut to actually work when you paste it into a manually created shortcut, that is what I based the TargetName on, the actual manual shortcut path that works.
 
have you stopped the code in debug on
objShortCut.TargetPath = TargetName
to see what TargetName looks like?
 
I have stopped the code and that is also why I sent the code to the form textbox to ensure that it was correct.
I can copy the code directly from the form textbox into an existing shortcut or a new manually created shortcut and it works perfectly, but removing quotes etc.. and it will fail.

That's what confuses me as it seems correct, but trying to create a new shortcut through code and it just doesn't like it, maybe it's too complex or long etc...
 

Users who are viewing this thread

Back
Top Bottom