Public Function fnRefreshTableLinks() As Boolean
' http://blogs.office.com/2012/08/03/automatically-relink-microsoft-access-tables/
 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
    tdf.RefreshLink
    iCount = iCount + 1
   End If
  End If
 Next tdf

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

fnRefreshTableLinks_Err:
 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"
 Application.Quit
 Resume fnRefreshTableLinks_Exit
End Function