Public Function link_to_BE()
'Recreate the links to tables in the back end database.
'Links are removed first to prevent the possibility of duplicating tables.
'Reset the name of the back end database in the 5th line below...
' Code works. (Founded From internet ...)
Dim tdf As TableDef
Dim i As Integer, j As Integer
Dim strBE As String
If MsgBox("Relink all tables?", vbYesNo + vbQuestion, strTitle) = vbNo Then Exit Function
strBE = Application.CurrentProject.Path & "\BE_DatabaseName.mdb"
'MsgBox strBE
Set Db = CurrentDb
On Error Resume Next
DoCmd.Hourglass True
For i = 0 To Db.TableDefs.Count - 1
Set tdf = Db.TableDefs(i)
If tdf.Properties(4) <> "" Then
If Left(tdf.Name, 4) <> "msys" Then
DoCmd.DeleteObject acTable, tdf.Name
End If
End If
Next i
Set tdf = Nothing
Set Db = Nothing
Set Db = DBEngine.Workspaces(0).OpenDatabase(strBE)
j = 0
For i = 0 To Db.TableDefs.Count - 1
Set tdf = Db.TableDefs(i)
If Left(tdf.Name, 4) <> "msys" Then
DoCmd.TransferDatabase acLink, "Microsoft Access", _
strBE, acTable, tdf.Name, tdf.Name
Else
j = j + 1
End If
Next i
DoCmd.Hourglass False
MsgBox Db.TableDefs.Count - j & " tables relinked.", vbOKOnly + vbInformation, strTitle
Set tdf = Nothing
Set Db = Nothing
End Function
