Deep dive: Opening an encrypted Access file via VBA based on the shortcut to the workgroup information file

 

Connexa XS add-ins enable you to select and alter Access databases from Excel.
Some databases, however, have been encrypted using user-level security; a workgroup information file handles the security regarding database objects and a workgroup file shortcut is needed to allow individual users to open the encrypted database with the right permissions.
We wanted users to be able to connect to these secured databases from Excel as well. This second article in our Deep Dive series explains how we did this.
The easiest way to open a secured Access database is to let the user select the link to the workgroup file (to be able to select a .lnk file in an Open File-dialog is another issue which will not be discussed in this article). The user-specific arguments stored in the shortcut target path are subsequently used to automatically open the encrypted Access file.

Typically the target path of a workgroup file shortcut looks like this:

“%ProgramFiles%\Microsoft Office\OFFICE[version]\MSACCESS.EXE” “\[path]\MyDb.mdb” /WRKGRP “\[path]\MyWorkgroup.mdw” /USER MyUser /PWD MyPassword

Often the last two arguments (username and password) are omitted in which case the user will have to enter his/her credentials manually when opening the database.

Underneath code excerpt demonstrates in a simplified manner how we accomplished this. In order to access the shortcut target you’ll need Wscript to instantiate a shell object. The shell creates a temporary link object based on the selected shortcut. The property TargetPath of the link object contains the string value with the desired argument information.
Finally the arguments are determined through string manipulation of the TargetPath .

Option Explicit
'Global constants
Public Const ERR_ABORT = 666

'Members
Private msWorkgroup As String
Private msUser As String
Private msPassword As String

'Test routine DetermineShortcutArgs
Sub TestMdwLinkArguments()

    Dim sLinkFile As String
    Dim sDbFile As String

    On Error GoTo ErrH

    'Determine the path to the mdw-shortcut
    sLinkFile = "[path]\MyShortcut.lnk"

    'Call the routine with the proper argument
    sDbFile = DetermineShortcutArgs(sLinkFile)

    'Display the argument values in the immediate window (Ctrl+G)
    Debug.Print "Database:", sDbFile
    Debug.Print "Workgroup:", msWorkgroup
    Debug.Print "User:", msUser
    Debug.Print "Password:", msPassword

    Exit Sub
ErrH:
    Select Case Err.Number

        Case ERR_ABORT
            MsgBox Err.Description, vbExclamation
        Case Else
            MsgBox "An unexpected error occurred:" & vbCr & _
                Err.Description, vbCritical
    End Select
End Sub

' Get the properties stored in the shortcut to the workgroup file
Private Function DetermineShortcutArgs(sFilename As String) As String

    Dim oShell As Object
    Dim oLink As Object
    Dim sarrArgs() As String
    Dim sArg As String
    Dim iPos As Integer
    Dim i As Integer

    On Error GoTo ErrH

    'Instantiate shell object
    Set oShell = CreateObject("WScript.Shell")

    'Create a new temporary shortcut to get the arguments
    Set oLink = oShell.CreateShortcut(sFilename)

    'Check validity of the link.
    If InStr(1, oLink.TargetPath, "MSACCESS.EXE", vbTextCompare) = 0 Then
        Err.Raise ERR_ABORT, , "The workgroup link is invalid."
    End If

    'Split the arguments into a string array
    sarrArgs = Split(oLink.Arguments, "/")

    'Loop through the array
    For i = LBound(sarrArgs) To UBound(sarrArgs)

        'First argument contains the target database
        If i = 0 Then
            DetermineShortcutArgs = _
                    Trim$(Replace(sarrArgs(i), Chr(34), vbNullString))
        Else
            'Manipulate the string to extract the property name
            iPos = InStr(1, sarrArgs(i), " ")
            sArg = LCase$(Left(sarrArgs(i), iPos - 1))

            'Determine the property value based on the property name
            Select Case sArg

                Case "wrkgrp"
                    msWorkgroup = GetArgValue(iPos, sarrArgs(i))
                Case "user"
                    msUser = GetArgValue(iPos, sarrArgs(i))
                Case "pwd"
                    msPassword = GetArgValue(iPos, sarrArgs(i))

            End Select
        End If
    Next

ErrH:
    'Clean up
    Set oLink = Nothing
    Set oShell = Nothing
    If Err.Number <> 0 Then
        Err.Raise Err.Number, Err.Source, Err.Description
    End If
End Function

'Distill the value part from the argument and return it
Private Function GetArgValue(iPos As Integer, sArgument As String) _
                                                            As String
    GetArgValue = _
    Trim$(Replace$(Mid(sArgument, iPos + 1), Chr(34), vbNullString))
End Function

User-level security is not supported anymore by the new file formats in MS Office Access 2007/2010. However it still works for .mdb files, even in the latest Office versions. Since no easy alternative exists (except elaborate programming) expectations are that workgroup security will be around for a while. Thus the code presented here will hopefully be of some use to someone!