You could use this Code to Check and relink tables
Public Function CheckLinks() As Boolean
' Check links to the database; returns True if links are OK.
Dim rst As New ADODB.Recordset
Dim StrSQL As String
On Error GoTo HandleErr
' Open linked table to see if connection information is correct.
CheckLinks = True
StrSQL = "SELECT * from [" & c_CheckFileName & "];"
rst.Open StrSQL, CurrentProject.Connection, adOpenUnspecified, adLockOptimistic
If Err = 0 Then
CheckLinks = True
Else
CheckLinks = RelinkTables
End If
ExitHere:
Exit Function
HandleErr:
Select Case Err.Number
Case Else
CheckLinks = RelinkTables
End Select
' End Error handling block.
End Function
Public Function RefreshLinks(strFileName As String) As Boolean
' Refresh links to the supplied database. Return True if successful.
Dim dbs As Database
Dim tdf As TableDef
' Loop through all tables in the database.
Set dbs = CurrentDb
For Each tdf In dbs.TableDefs
' If the table has a connect string, it's a linked table.
If Len(tdf.Connect) > 0 Then
tdf.Connect = ";DATABASE=" & strFileName
Err = 0
On Error Resume Next
tdf.RefreshLink ' Relink the table.
If Err <> 0 Then
RefreshLinks = False
Exit Function
End If
End If
Next tdf
RefreshLinks = True ' Relinking complete.
End Function
Public Function RelinkTables() As Boolean
' Tries to refresh the links to the database.
' Returns True if successful.
Dim strAccDir As String
Dim strSearchPath As String
Dim strSearchPathAlt As String
Dim strFileName As String
Dim intError As Integer
Dim strError As String
Const conMaxTables = 8
Const conNonExistentTable = 3011
Const conNotSrigou = 3078
Const conSrigouNotFound = 3024
Const conAccessDenied = 3051
Const conReadOnlyDatabase = 3027
Const conAppTitle = ".."
strSearchPath = CurrentDb().Name
Dim lLen As Integer
lLen = Len(strSearchPath)
While Mid(strSearchPath, lLen, 1) <> "\"
lLen = lLen - 1
Wend
strSearchPath = Left(strSearchPath, lLen)
' Look for the database.
If (Dir(strSearchPath & c_DataBaseFileName) <> "") Then
strFileName = strSearchPath & c_DataBaseFileName
Else
strSearchPath = "Full path where the Server side of data resides"
If (Dir(strSearchPath & c_DataBaseFileName) <> "") Then
strFileName = strSearchPath & c_DataBaseFileName
Else
' Can't find Data, so display the Open dialog box.
MsgBox "I cant Find " & c_DataBaseFileName & ". Please Find it to continue " _
& ".", vbExclamation
strFileName = FindProData(strSearchPath)
If strFileName = "" Then
strError = "Please supply a valid name"
GoTo Exit_Failed
End If
End If
End If
' Fix the links.
If RefreshLinks(strFileName) Then
RelinkTables = True
Exit Function
End If
' If it failed, display an error.
Select Case Err
Case conNonExistentTable, conNotSrigou
strError = "The table you are searching does not exist"
Case Err = conSrigouNotFound
strError = "The Database was not found."
Case Err = conAccessDenied
strError = "You do not have permitions in the DB."
Case Err = conReadOnlyDatabase
strError = "The DB is Read Only"
Case Else
strError = Err.Description
End Select
Exit_Failed:
MsgBox strError, vbCritical
RelinkTables = False
End Function
Public Function FindLinks() As String
' Refresh links to the supplied database. Return True if successful.
Dim dbs As Database
Dim tdf As TableDef
' Loop through all tables in the database.
Set dbs = CurrentDb
For Each tdf In dbs.TableDefs
' If the table has a connect string, it's a linked table.
If Len(tdf.Connect) > 0 Then
FindLinks = Mid(tdf.Connect, 11, Len(tdf.Connect) - 7)
Exit Function
End If
Next tdf
End Function
