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

1

  • 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.

2

  • 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.

3

  • Create a new macro and name it “Autoexec”:

4

  • 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

 

 

 

View Our Impressive List of Clients
Back To Home Page
Contact Us For A Free Quote