Relinking to your access database

When you are developing an application in house you can define the directory where the backend database will sit. But if your application is used in a number of offices the users will need to relink the program to the source of there database.

I got this code from a developer in the UK in the late 90’s cant remember his name

To use the code open a form and add a text box which the user will enter the path to the file and a button called “relink”

Add an onclick code event to the button and insert the following code

Private Sub cmdRefresh_Click()
   On Error GoTo cmdRefreshErr
   Dim sTest As String, dblocal As Database
   Dim tdlocal As TableDef
   On Error Resume Next
   sTest = Dir(Me![txtFilename])
   On Error GoTo cmdRefreshErr
   If Len(sTest) = 0 Then
      MsgBox "File not found, Please try again.", vbExclamation, "Link to new Data file"
   ElseIf TablesMatch(Me![txtFilename]) Then
      Set dblocal = CurrentDb
      DoCmd.Hourglass True
      For Each tdlocal In dblocal.TableDefs
         If Len(tdlocal.Connect) > 0 Then
            DoCmd.Echo True, "Linking " & tdlocal.Name
            tdlocal.Connect = ";DATABASE=" & Trim(Me![txtFilename])
            tdlocal.RefreshLink
         End If
      Next
      DoCmd.Echo True, "Done"
      DoCmd.Hourglass False
      MsgBox "Linking to new back-end data file was successful."
      DoCmd.Close acForm, Me.Name
      If IsLoaded("frmLoading") Then
        DoCmd.Close acForm, "frmLoading"
        DoCmd.OpenForm "frmLoading"
      End If

   Else
      MsgBox "The tables in the data file " & Me![txtFilename] & " didn't match the current database"
   End If
ExitcmdRefreshErr:
   DoCmd.Echo True
   DoCmd.Hourglass False
   Exit Sub
cmdRefreshErr:
Select Case Err
Case Else
   MsgBox Err.Number & " - " & Err.descripton
   Resume ExitcmdRefreshErr
End Select
End Sub