If you’ve split your database into a front end and back end, you will from time to time need to update the links between the two, especially if you are in a development mode, passing the db back and forth to the developer. Here is a method to automate that.
- Create a new blank database called FrontEnd.accdb
- On the File menu, under Get External Data, click Access, then “Link Tables”. Create a link to each of the tables in the back end database.
- Browse to select the sample database backend.accdb, and then click Link. In the Link Tables dialog box, click Select All, and then click OK.
- Create a new macro and name it “Autoexec”:
- Create a module, name it “Util” and in it put the code below. This code will first search for the front end in the same location it’s already mapped to, if it doesn’t find it, it will search for it in the same folder where the back end exists, if it doesn’t find it, it will prompt the user to browse to located it manually.
Public Function Main()
Dim linking As Relinking
Set linking = New Relinking
If linking.ReLink(True) = False Then
Message = “Couldn’t find the Backend DB. Please locate and link DB Manually.”
ShowMessage Message
End If
SetPropertiesForAccess
If StartFormName <> “” Then
DoCmd.OpenForm StartFormName, acNormal
End If
If Debugging = True Then
End If
End Function
Option Compare Database
Dim DB As Object
Const dbName As String = “backend.accdb”
Private Sub Class_Initialize()
Set DB = CurrentDb
End Sub
Public Function ReLink(Optional ShowMessage As Boolean = True) As Boolean
Dim bEnd_dbName As String
On Error GoTo ReLink_Error
bEnd_dbName = GetLinkName
If PathExists(bEnd_dbName) Then
ReLink = True
Else
Dim mainPath As String
mainPath = CurrentProject.path & “\” & dbName
If PathExists(mainPath) Then
LinkTables mainPath
If (ShowMessage) Then
Util.ShowMessage “The tables are relinked to ” & mainPath & “.”
End If
ReLink = True
Else
DoCmd.OpenForm “frmBrowse_backEnd”, acNormal, , , , acDialog
If Context.YesNo_Value = 1 Then
LinkTables SelectedPath
If (ShowMessage) Then
Util.ShowMessage “The tables are relinked to ” & SelectedPath & “.”
End If
ReLink = True
Else
ReLink = False
End If
End If
End If
On Error GoTo 0
Exit Function
ReLink_Error:
MsgBox “Error ” & Err.Number & ” (” & Err.description & “) in procedure ReLink of Class Module Relinking”
ReLink = True
End Function
Private Function PathExists(path As String) As Boolean
Dim fso As FileSystemObject
Set fso = New FileSystemObject
PathExists = fso.FileExists(path)
Set fso = Nothing
End Function
Public Function GetLinkName() As String
Dim tblDef As TableDef
For Each tblDef In DB.TableDefs
If tblDef.Connect <> “” Then
GetLinkName = ExtractDBName(tblDef.Connect)
Exit Function
End If
Next tblDef
End Function
Public Function LinkTables(newDBName As String) As String
Dim tblDef As TableDef
For Each tblDef In DB.TableDefs
If tblDef.Connect <> “” Then
Dim newConnect As String
newConnect = ExtractDBName(tblDef.Connect)
tblDef.Connect = Replace(tblDef.Connect, newConnect, newDBName)
tblDef.RefreshLink
End If
Next tblDef
End Function
Public Function ExtractDBName(stringConnect As String) As String
Dim varArray() As String
Dim value
varArray = Split(stringConnect, “;”)
For Each value In varArray
If InStr(1, value, “Database=”) > 0 Then
ExtractDBName = Replace(value, “Database=”, “”)
End If
Next value
End Function
Public Function IsLinked() As Boolean
On Error Resume Next
IsLinked = Len(GetLinkName) > 0
End Function
