' Links tables (that are linked already) to a backend DB dynamically and relative to the front-end. When tables are linked by Access,
' the path to the link is saved as a an absolute path, meaning that if the DB and backend are ever moved, then the links all break.
' CAVEAT - for this to work, the backend DBs for the linked tables must be in the same directory, but not necessarily the same directory
' as the frontend. (If it is in a different directory then it must be in a sub-directory of the frontend DB's directory.
'
Public Function LinkTables()
Dim Tdf As TableDef ' table definition
Dim iLoop As Integer, tblCtr ' loop counter, counts the number of tables
Dim sFE_Path As String, sBE_Path As String ' frontend path, backend path
Dim sBE_DB As String ' name of the backend MDB file
' Get the path of this database, i.e. the front-end
With Application.CodeDb
sFE_Path = Left(.Name, InStr(.Name, Dir(.Name)) - 1)
End With
' if the backend is in a different directory, it would be defined here
' e.g. sBE_Path = sFE_Path & "backend\"
sBE_Path = sFE_Path
'Loop through the tables collection, updating each link
For Each Tdf In CurrentDb.TableDefs
If Tdf.SourceTableName <> "" Then
' cuts down processing time if all the tables link to the same backend MDB
If tblCtr = 0 Then
sBE_DB = GetDB(Tdf.Connect)
End If
tblCtr = tblCtr + 1
' only updates link the DBs have been moved
If (Right(Tdf.Connect, Len(Tdf.Connect) - 10)) <> (sBE_Path & sBE_DB) Then
Tdf.Connect = ";DATABASE=" & sBE_Path & sBE_DB
Tdf.RefreshLink 'Refresh the link
End If
End If
Next 'Goto next table
End Function
' Gets the MDB filename without the directory information.
Private Function GetDB(strFullPath As String) As String
Dim I As Integer
' I used this loop instead of using InstrRev, so that the code is compatible with Access '97 still. (InStrRev did not appear until v2000)
For I = Len(strFullPath) To 1 Step -1
If Mid(strFullPath, I, 1) = "\" Then
GetDB = Right(strFullPath, Len(strFullPath) - I)
Exit For
End If
Next
End Function