Relinking multiple linked tables that are linked to different databases

xtyle86 · #1 (**permalink**) 02-02-12, 14:23

Hello,

I have a database with a number of linked tables that are linked to tables in different databases (not a back-end)

for example,
I have table1 that is linked to table1 in K:\database\db1.mdb.
table2 linked to table2 in S:\data\data.mdb.
and so on...

However, recently we have moved all our databases to a new location.
K:\database\db1.mdb is now residing in O:\master\database
and S:\data\data.mdb is now residing in O:\master\data
and so on...

I'm now in charge of relinking all those tables to point to the new location.
I would do this in linked table manager one by one but we have 100s of tables linked to multiple different databases in different location.

My question is,

is there a way to create a VBA code that will automatically do this re-linking process?

so,
1. find unlinkable tables
2. search its new location under O:\master
3. re-link it to the new location

database names and tables names have not been changed. Just the location of databases.

Thank you in advance,

Sinndho · #2 (**permalink**) 02-02-12, 17:34

Here's a solution:

Code:

Sub RelinkTables(ByVal SearchPath As String)
'
' Note: A reference to the Microsoft Office Object Library is needed.
' ----  For Access 2003: Menu "Tools" --> "References" --> "Microsoft Office 12.0 Object Library"
'
    Dim dbs As DAO.Database
    Dim tdf As DAO.TableDef
    Dim strDBName As String

    Set dbs = CurrentDb
    For Each tdf In dbs.TableDefs
        If tdf.Connect <> "" Then
            Debug.Print tdf.Name, tdf.Connect
            strDBName = Mid(tdf.Connect, InStrRev(tdf.Connect, "\") + 1)
            Debug.Print strDBName
            
            With Application.FileSearch
                .NewSearch
                .SearchSubFolders = True
                .MatchTextExactly = True
                .FileType = msoFileTypeAllFiles
                .FileName = strDBName
                .LookIn = SearchPath
                .Execute
                If .FoundFiles.Count = 0 Then
                    MsgBox "File: " & strDBName & "was not found.", vbInformation, "RelinkTables"
                ElseIf .FoundFiles.Count = 1 Then
                    tdf.Connect = ";DATABASE=" & .FoundFiles(1)
                    tdf.RefreshLink
                Else
                    MsgBox "Several files named: " & strDBName & " were found.", vbInformation, "RelinkTables"
                End If
            End With
            
        End If
    Next tdf
    Set dbs = Nothing
    
End Sub

You can call the procedure like this:

Code: