"I have three data bases: A front end and two back ends. The back ends are exactly the same structure. One is a live system amd the other is a test system. The data differs slightly in that test system is older data. I would like to re-link the tables betwen the test and production systems."
This is what I use. This will prompt you with the current connection. If you change it, it re-links. If you don't change it, it just goes away.
For this to work, I also create a query named 'qryBackEnd' that looks for a table that I know exists (In this example, tblCase) to determine the current connection.
This is the qryBackEnd:
SELECT MSysObjects.Database FROM MSysObjects WHERE (((MSysObjects.Name)='tblCase'));
This is the re-link code:
Sub ReLinkTables()
Dim s As String, resp, txt As String, good As String, bad As String
Dim db As Database, tdf As TableDef
good = "Tables have been re-linked to:" & vbCrLf & vbCrLf
bad = "The tables are still connected to:" & vbCrLf & vbCrLf
txt = "Verify the name and location " & vbCrLf & "of the back-end
database. . ."
On Error GoTo err_open
s = DLookup("[Database]", "qryBackEnd")
'
resp = InputBox(txt, " ", s)
If Not IsNull(resp) Then
If Len(resp) > 0 Then
If InStr(1, resp, ":") > 0 And InStr(1, resp, "\") > 0 And
Right(resp, 4) = ".mdb" Then
If resp <> s Then
' re-link the tables
DoCmd.Hourglass True
Set db = CurrentDb
For Each tdf In db.TableDefs
With tdf
If Left(.Name, 4) <> "MSys" And Len(tdf.Connect)
<> 0 Then
Debug.Print tdf.Name
.Connect = ";DATABASE=" & resp
.RefreshLink
End If
End With
Next tdf
MsgBox (good & resp)
End If
End If
End If
End If
exit_open:
DoCmd.Hourglass False
Exit Sub
'
err_open:
resp = MsgBox(Err.Description, vbOKOnly + vbCritical)
resp = MsgBox(bad & s, vbExclamation + vbOKOnly, "WARNING!")
Resume exit_open
'
End Sub