Below is the code I copied from RHICKS above. Again it does nothing to my database. I make a Macro and use RUNCODE and place CheckLink() in the Function name line.
START CODE:
'This function checks the linked tables in the current database and repairs broken
'links. The database containing the source tables must reside in the same directory
'and it name must be entered in the constant constrData
'Call the function CheckLink in the AutoExec macro or in the OnOpen event
'of the startup form.
Public Const constrData As String = "FileName_be.mdb"
'Constant with the name of the database that contains the source tables
Public Function CheckLink() As Boolean
Dim fRepairNeeded As Boolean
Dim rsTable As Recordset
Dim tdTable As TableDef
On Error GoTo LinkError
For Each tdTable In CurrentDb.TableDefs
'Check for each table if it is part of the mdb or if it is a linked table
'The connect property of linked tables contain the path of the source db
If Len(tdTable.Connect) > 0 Then
'Open the linked table, if it isn't available an error is raised and
'the error routine will be executed
Set rsTable = CurrentDb.OpenRecordset(tdTable.Name, dbOpenSnapshot)
rsTable.Close
End If
Next tdTable
CheckLink = True
If fRepairNeeded Then
MsgBox "Linked tables are reattached", _
vbOKOnly + vbCritical, _
"Reattaching linked tables"
End If
Set tdTable = Nothing
Set rsTable = Nothing
Exit Function
LinkError:
Select Case Err.Number
Case 0, 91
Resume Next
'Linked table isn't available. Call the function to repair the link
Case 3024
If Not Repairlink Then
CheckLink = False
MsgBox "Not all linked tables could be reattached", _
vbOKOnly + vbCritical, _
"Reattaching linked tables"
Set tdTable = Nothing
Set rsTable = Nothing
Exit Function
Else
fRepairNeeded = True
Resume Next
End If
Case Else
MsgBox Err.Number & " " & Err.Description
CheckLink = False
Set tdTable = Nothing
Set rsTable = Nothing
Exit Function
End Select
End Function
Public Function Repairlink() As Boolean
Dim dbApplic As Database
Dim intCounter As Integer
Dim strDir As String
Dim tdTable As TableDef
Set dbApplic = CurrentDb
'Get the directory out of the Name property of the current database
For intCounter = Len(dbApplic.Name) To 1 Step -1
If Mid(dbApplic.Name, intCounter, 1) = "\" Then
strDir = Mid(dbApplic.Name, 1, intCounter)
Exit For
End If
Next intCounter
For Each tdTable In dbApplic.TableDefs
'If the table has a connect string than it is a linked table
'The link must be repaired
If Len(tdTable.Connect) > 0 Then
'constrData is the constant containing the name of the source database
tdTable.Connect = ";DATABASE=" & strDir & constrData
Err.Number = 0
On Error Resume Next
tdTable.RefreshLink
If Err.Number <> 0 Then
Repairlink = False
Exit Function
End If
End If
Next tdTable
Repairlink = True
Set tdTable = Nothing
Set dbApplic = Nothing
End Function
END CODE:
When I try to compile, I get a syntax error on the following line:
Public Const constrData As String = "FileName_be.mdb"
Thanks.
Thomas Bailey
tbailey@datjc.com