Function to Refresh Table Links in MS Access VBA

This has to be the most useful piece of bespoke code I have ever got from a Microsoft website! Copy all the backend databases into a development area then the front end and run this piece if code in the front end "et voila" you have a working copy of your live database to work on.

Public Function fnRefreshTableLinks() As Boolean
 On Error GoTo fnRefreshTableLinks_Err
 fnRefreshTableLinks = False
 Dim db As DAO.Database
 Dim tdf As DAO.TableDef
 Dim sConnect As String
 Dim sBackEnd As String
 Dim iCount As Integer

 Set db = CurrentDb
 iCount = 0

 For Each tdf In db.TableDefs
  If Left$(tdf.Connect, 10) = ";DATABASE=" Then
   sConnect = Nz(tdf.Connect, "")
   sBackEnd = Right$(sConnect, (Len(sConnect) - (InStrRev(sConnect, "\") - 1)))
   If Len(sBackEnd & "") > 0 Then
    Set tdf = db.TableDefs(tdf.Name)
    tdf.Connect = ";DATABASE=" & CurrentProject.path & sBackEnd
    iCount = iCount + 1
   End If
  End If
 Next tdf

 MsgBox iCount & " table links refreshed"
 Set tdf = Nothing
 Set db = Nothing
 fnRefreshTableLinks = True
 Exit Function

 Dim sFilename As String
 sFilename = CurrentProject.path & "\err" & Format(Now(), "yyyymmddHHMMSS") & ".txt"
 Open sFilename For Output As #1
 Print #1, "database - Error Log"
 Print #1, Now()
 Print #1, Err.Number
 Print #1, Err.Description
 Print #1, CurrentDb.Name
 Print #1, CurrentProject.path
 Print #1, "Table Name ***" & tdf.Name
 Print #1, "Connect String ***" & sConnect
 Print #1, "fnRefreshTableLinks_Err"
 Print #1, "**End**"
 Close #1
 MsgBox "Error relinking tables"
 Resume fnRefreshTableLinks_Exit
End Function

Tags - Microsoft Access 2013, Microsoft Access 2010, Microsoft Access 2007, refresh table links, VBA, code, Microsoft, Visual BASIC for Applications, front end, back end, relink, connect string