Relink Microsoft Access Tables with VBA

How Links Are Stored

Relinking to an Access Back End

Public Function RelinkAccessTables(ByVal backEndPath As String) As Boolean
    Dim db As DAO.Database, td As DAO.TableDef
    Dim newConnect As String, failed As String

    If Dir(backEndPath) = "" Then
        MsgBox "Back end not found: " & backEndPath, vbExclamation
        Exit Function
    End If

    newConnect = ";DATABASE=" & backEndPath
    Set db = CurrentDb
    For Each td In db.TableDefs
        ' Only Access-linked tables (skip local and ODBC tables)
        If Len(td.Connect) > 0 And InStr(1, td.Connect, "DATABASE=", vbTextCompare) > 0 _
           And Left$(td.Connect, 5) <> "ODBC;" Then
            If td.Connect <> newConnect Then
                td.Connect = newConnect
                On Error Resume Next
                td.RefreshLink
                If Err.Number <> 0 Then failed = failed & td.Name & " (" & Err.Description & ")" & vbCrLf
                On Error GoTo 0
            End If
        End If
    Next td

    If Len(failed) > 0 Then
        MsgBox "Could not relink:" & vbCrLf & failed, vbExclamation
    Else
        RelinkAccessTables = True
    End If
End Function

Checking Links at Startup

Public Function EnsureLinks() As Boolean
    Dim target As String
    target = Nz(DLookup("BackEndPath", "tblLocalSettings"), "")   ' local table in the FE

    On Error Resume Next
    Dim n As Long: n = DCount("*", "tblCustomers")                  ' any small linked table
    If Err.Number = 0 And InStr(1, CurrentDb.TableDefs("tblCustomers").Connect, _
                                target, vbTextCompare) > 0 Then
        EnsureLinks = True: Exit Function
    End If
    On Error GoTo 0

    If Len(target) = 0 Or Dir(target) = "" Then target = BrowseForBackEnd()
    If Len(target) = 0 Then Exit Function
    If RelinkAccessTables(target) Then
        CurrentDb.Execute "UPDATE tblLocalSettings SET BackEndPath='" & _
                          Replace(target, "'", "''") & "'", dbFailOnError
        EnsureLinks = True
    End If
End Function

Private Function BrowseForBackEnd() As String
    With Application.FileDialog(3)                  ' msoFileDialogFilePicker
        .Title = "Locate the database back end"
        .Filters.Clear
        .Filters.Add "Access database", "*.accdb; *.mdb"
        If .Show Then BrowseForBackEnd = .SelectedItems(1)
    End With
End Function

Relinking to SQL Server (DSN-less)

Public Sub RelinkSqlTables(ByVal server As String, ByVal database As String)
    Dim td As DAO.TableDef, cn As String
    cn = "ODBC;DRIVER={ODBC Driver 18 for SQL Server};SERVER=" & server & _
         ";DATABASE=" & database & ";Trusted_Connection=Yes;Encrypt=Yes;"
    For Each td In CurrentDb.TableDefs
        If Left$(td.Connect, 5) = "ODBC;" Then
            td.Connect = cn
            td.RefreshLink
        End If
    Next td
End Sub

Development, Test and Production

• Keep the target path or server in tblLocalSettings, with an Environment field (DEV, TEST, PROD).

• Show the environment in the title bar or a coloured banner so nobody edits production thinking it is test.

• Before creating the release .accde, run the relink to PROD in a build step.

• Never let a front end silently fall back to a local copy of the back end.

Common Problems