Re-lier les tables Access

Function RelinkTables()
 Dim td As TableDef, db As Database
 Dim strFolder As String, arTmp As Variant, strBe As String

 Set db = CurrentDb
 strFolder = Left(db.Name, InStrRev(db.Name, "\", , vbTextCompare))

 For Each td In db.TableDefs
  If Left(td.Connect, 9) = ";DATABASE" Then   'linked ?
   If Not fValidTable(td.Name) Then        'bad ?
    arTmp = Split(td.Connect, "\")
    td.Connect = ";DATABASE=" & strFolder & arTmp(UBound(arTmp))
    td.RefreshLink
   End If
  End If
 Next td
End Function

Function fValidTable(TableName As String) As Boolean
 Dim lCount As Long
 On Error Resume Next
 lCount = DFirst("1", TableName)
 fValidTable = (Err.Number = 0)
End Function