Linked Tables - Reattaching Programmatically

Overview

Microsoft Access has a feature called Linked Tables, which are tables that are dynamically linked to another data source. Linked tables are commonly linked to a "back end" database, which is a database containing only data and no code. When distributing the front end counterpart to a new machine, the links to the back end can get broken, because the path to the back end database is stored in each linked table as absolute path. This article contains code that will automatically re-link the linked tables in a database when the database is opened and the links are broken.

Solution

Relinking to Another Access Database

{copytext|RelinkTablesToAccess}
Sub RelinkTablesToAccess()

    Dim rst As DAO.Recordset
    Dim intNumTables As Integer
    Dim varReturn As Variant
    Dim intI As Integer
    Dim tdf As TableDef
    Dim fd As Office.FileDialog
    Dim vrtSelectedItem As Variant
    Dim sFileName As String
    Dim tableName As String
    
    On Error Resume Next
    Set rst = CurrentDb.OpenRecordset("AcctExec", dbOpenDynaset)
    
    'check for failure - the link must be bad.
    If Err <> 0 Then
    
        'get the new location
        Set fd = Application.FileDialog(msoFileDialogFilePicker)
        fd.Title = "Please select the backend database"
        fd.Filters.Clear
        fd.Filters.Add "Access Databases", "*.accdb"
        
        If fd.Show = True Then
            For Each vrtSelectedItem In fd.SelectedItems
                sFileName = vrtSelectedItem
            Next
        End If
        
        'Rebuild the links.  Check for the number of tables first
        intNumTables = CurrentDb.TableDefs.Count
        varReturn = SysCmd(acSysCmdInitMeter, "Relinking tables", intNumTables)
        
        'Loop through all tables.  Reattach those with nonzero-length Connect strings
        intI = 0
        For Each tdf In CurrentDb.TableDefs
        
            'if connect is blank, it's not a linked table
            If Len(tdf.Connect) > 0 Then
            
                intI = intI + 1
                'tdf.Connect = ";DATABASE=" & sFileName
                CurrentDb.TableDefs.Delete tdf.name
                
                tableName = tdf.name
                
                Set tdf = CurrentDb.CreateTableDef(tableName)
                tdf.Connect = ";DATABASE=" & sFileName
                tdf.SourceTableName = tableName
                tdf.RefreshLink
                CurrentDb.TableDefs.Append tdf
                
            End If
            
            varReturn = SysCmd(acSysCmdUpdateMeter, intI)
            
        Next tdf
        
        varReturn = SysCmd(acSysCmdRemoveMeter)
        
    End If
  
End Sub

Relinking to SQL Server

{copytext|RelinkTablesToSqlServer}
Sub RelinkTablesToSqlServer()

    Dim intNumTables As Integer
    Dim varReturn As Variant
    Dim intI As Integer
    Dim tdf As TableDef
    Dim fd As Office.FileDialog
    Dim vrtSelectedItem As Variant
    Dim serverName As String
    Dim dbName As String
    Dim tableName As String
    
    'Rebuild the links.  Check for the number of tables first
    intNumTables = CurrentDb.TableDefs.Count
    varReturn = SysCmd(acSysCmdInitMeter, "Relinking tables", intNumTables)
    
    serverName = "MyServer"
    dbName = "MyDatabase"
    
    
    'Loop through all tables.  Reattach those with nonzero-length Connect strings
    intI = 0
    For Each tdf In CurrentDb.TableDefs
    
        'if connect is blank, it's not a linked table
        If Len(tdf.Connect) > 0 Then
        
            intI = intI + 1
            'tdf.Connect = ";DATABASE=" & sFileName
            tableName = "dbo." & tdf.name
            tdf.Connect = TableConnect(serverName, dbName, tableName, True, "MyUser", "MyPassword")
            tdf.RefreshLink
            
        End If
        
        varReturn = SysCmd(acSysCmdUpdateMeter, intI)
        
    Next tdf
    
    varReturn = SysCmd(acSysCmdRemoveMeter)
  
End Sub
'==================================================================================================
Private Function TableConnect(serverName As String, dbName As String, targetTable As String, _
Optional trustedConnection As Boolean = True, Optional userName As String = "", Optional password _
As String = "") As String

    Dim result As String
    
    If trustedConnection Then
        result = "ODBC;DRIVER=SQL Server;SERVER={server};DATABASE={db};Trusted_Connection=Yes"
    Else
        result = "ODBC;DRIVER=SQL Server;SERVER={server};UID={username};PWD={password};DATABASE={db}"
    End If
    
    result = Replace$(result, "{server}", serverName)
    result = Replace$(result, "{db}", dbName)
    result = Replace$(result, "{table}", targetTable)
    result = Replace$(result, "{username}", userName)
    result = Replace$(result, "{password}", password)

    TableConnect = result

End Function