Can I create shorcut using VBA? 1

[wtstro]

I have an MS-Access application that uses a workgroup. Using VBA I want the user to click on a button that will create a shortcut to the application with the /wrkgrp parameter added to the target string (example: D:\MyProgram\MyAccessApp.mdb /wrkgrp d:\MyProgram\MyAccessSecurity.mdw)
I have been looking for almost a week now. Can anyone help me???

 

[dsi]

You can use fCreateShellLink to create a shortcut. This example can be tweaked, but it creates program shortcuts to the desktop.

Option Explicit

Private Declare Function fCreateShellLink Lib "Vb5stkit.dll" (ByVal _
    lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal _
    lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long

Sub CreateShortcut(sDisplayName As String, sFullPath As String)
    Dim lReturn As Long
    Dim sDeskName As String
    Dim sLinkArgs As String
    On Error GoTo ErrHndlr
    'Add to Desktop
    sDeskName = "..\..\Desktop"
    sLinkArgs = ""
    lReturn = fCreateShellLink(sDeskName, sDisplayName, sFullPath, sLinkArgs)
    If lReturn <> 1 Then
        MsgBox &quot;There was an error creating the shortcut:&quot; & vbCrLf & sDisplayName & vbCrLf & sFullPath
    End If
    Exit Sub
ErrHndlr:
    sDeskName = &quot;System Error in CreateShortcut()!&quot;
    sDeskName = sDeskName & &quot;Error No: &quot; & Err.Number & vbCrLf & &quot;Error Desc: &quot; & Err.Description
    sDeskName = sDeskName & vbCrLf & sDisplayName & vbCrLf & sFullPath
    Err.Clear
    MsgBox sDeskName
End Sub

'Then, to Call it
Call CreateShortcut(&quot;SomeName&quot;, &quot;D:\SomeFolder\SomeFile.mdb&quot;)

Hope that helps...

 

[wtstro]

Thanks do dsi for the suggestion above. I needed to be able to include the parameter to use an MS-Access workgroup that is being used by the database.

I played with this for quite some time the arrive at this solution:

Option Explicit

Public Declare Function fCreateShellLink Lib "Vb5stkit.dll" (ByVal _
lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal _
lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long


Sub DoShortcut()
Dim lReturn As Long
Dim DestPath As String
Dim LinkArg As String
Dim ShortcutName As String
Dim AppPath As String

AppPath = "D:\Program Files\TSMN\"
DestPath = "C:\Program Files\Microsoft Office\Office\MSAccess.EXE"
LinkArg = " " & Chr(34) & AppPath & "TSMN.mdb" & Chr(34) & " /wrkgrp " & Chr(34) & AppPath & "TSMNSys.mdw" & Chr(34)
ShortcutName = "Shortcut to TSMN"

'Add shortcut to desktop
lReturn = fCreateShellLink("..\..\Desktop", ShortcutName, DestPath, LinkArg)
If lReturn = 0 Then
Beep
MsgBox "Error while creating Desktop shortcut for: " & ShortcutName & ".", vbCritical + vbOKOnly, "Create Error"
End If

'Add shortcut to Program Menu Group
lReturn = fCreateShellLink("", ShortcutName, DestPath, LinkArg)
If lReturn = 0 Then
Beep
MsgBox "Error while creating Program Menu Group shortcut for: " & ShortcutName & ".", vbCritical + vbOKOnly, "Create Error"
End If

'Add shortcut to Startup Group
'Note that on Windows NT, the shortcut will not actually appear in the Startup group until your next reboot.
lReturn = fCreateShellLink("\Startup", ShortcutName, DestPath, LinkArg)
If lReturn = 0 Then
Beep
MsgBox "Error while creating Startup Group shortcut for: " & ShortcutName & ".", vbCritical + vbOKOnly, "Create Error"
End If

End Sub


Call DoShortcut() from your code. It was important to set up the LinkArg variable using the Chr(34) in order to account for spaces within a folder name.

 

[wtstro]

Thanks to dsi for the suggestion above. I needed to be able to include the parameter to use an MS-Access workgroup that is being used by the database.

I played with this for quite some time the arrive at this solution:

Option Explicit

Public Declare Function fCreateShellLink Lib "Vb5stkit.dll" (ByVal _
lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal _
lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long


Sub DoShortcut()
Dim lReturn As Long
Dim DestPath As String
Dim LinkArg As String
Dim ShortcutName As String
Dim AppPath As String

AppPath = "D:\Program Files\TSMN\"
DestPath = "C:\Program Files\Microsoft Office\Office\MSAccess.EXE"
LinkArg = " " & Chr(34) & AppPath & "TSMN.mdb" & Chr(34) & " /wrkgrp " & Chr(34) & AppPath & "TSMNSys.mdw" & Chr(34)
ShortcutName = "Shortcut to TSMN"

'Add shortcut to desktop
lReturn = fCreateShellLink("..\..\Desktop", ShortcutName, DestPath, LinkArg)
If lReturn = 0 Then
Beep
MsgBox "Error while creating Desktop shortcut for: " & ShortcutName & ".", vbCritical + vbOKOnly, "Create Error"
End If

'Add shortcut to Program Menu Group
lReturn = fCreateShellLink("", ShortcutName, DestPath, LinkArg)
If lReturn = 0 Then
Beep
MsgBox "Error while creating Program Menu Group shortcut for: " & ShortcutName & ".", vbCritical + vbOKOnly, "Create Error"
End If

'Add shortcut to Startup Group
'Note that on Windows NT, the shortcut will not actually appear in the Startup group until your next reboot.
lReturn = fCreateShellLink("\Startup", ShortcutName, DestPath, LinkArg)
If lReturn = 0 Then
Beep
MsgBox "Error while creating Startup Group shortcut for: " & ShortcutName & ".", vbCritical + vbOKOnly, "Create Error"
End If

End Sub


Call DoShortcut() from your code. It was important to set up the LinkArg variable using the Chr(34) in order to account for spaces within a folder name.