Option Compare Database
Option Explicit
Dim UnProcessed As New Collection
Public strPath As String
Public Sub AppendTables()
On Error GoTo errLbl:
Dim db As DAO.Database, x As Variant
Dim strTest As String
' Add names of all table with invalid links to the Unprocessed Collection.
Set db = CurrentDb
ClearAll
For Each x In db.TableDefs
If Len(x.Connect) > 1 And Len(Dir(Mid(x.Connect, 11))) = 0 Then
' connect string exists, but file does not
UnProcessed.Add Item:=x.Name, Key:=x.Name
End If
Next
Exit Sub
errLbl:
If Err.Number = 52 Then
MsgBox "Network not present."
For Each x In db.TableDefs
If Len(x.Connect) > 1 Then
'MsgBox x.Name & " " & x.Connect
' connect string exists, but file does not
UnProcessed.Add Item:=x.Name, Key:=x.Name
End If
Next
Else
Call ErrHandler(Err.Number, Err.Description, "Error in Appendtables")
End If
End Sub
Public Function ProcessTables()
Dim strTest As String
On Error GoTo Err_BeginLink
' Call procedure to add all tables with broken links into a collection.
AppendTables
' Test for existence of file name\directory selected in Common Dialog Control.
strTest = strPath
On Error GoTo Err_BeginLink
If Len(strTest) = 0 Then ' File not found.
MsgBox "File not found. Please try again.", vbExclamation, "Link to new data file"
Exit Function
End If
' Begin relinking tables.
Relinktables (strTest)
' Check to see if all tables have been relinked.
CheckifComplete
DoCmd.Echo True, "Done"
If UnProcessed.Count < 1 Then
MsgBox "Linking to new back-end data file was successful."
Else
MsgBox "Not All back-end tables were successfully relinked."
End If
Exit_BeginLink:
DoCmd.Echo True
Exit Function
Err_BeginLink:
Debug.Print Err.Number
If Err.Number = 457 Then
ClearAll
Resume Next
ElseIf Err.Number = 3043 Then
MsgBox "Can not find the Master on the Network. Check that you have a good network connection."
Resume Exit_BeginLink
Else
Call ErrHandler(Err.Number, Err.Description, "Error in Processtables")
Resume Exit_BeginLink
End If
End Function
Public Sub ClearAll()
Dim x
' Clear any and all names from the Unprocessed Collection.
For Each x In UnProcessed
UnProcessed.Remove (x)
Next
End Sub
Public Function Relinktables(strFileName As String)
Dim dbbackend As DAO.Database, dblocal As DAO.Database, ws As Workspace, x, y
Dim tdlocal As DAO.TableDef
On Error GoTo Err_Relink
Set dbbackend = DBEngine(0).OpenDatabase(strFileName)
Set dblocal = CurrentDb
' If the local linked table name is found in the back-end database
' we're looking at, Recreate & Refresh its connect string, and then
' remove its name from the Unprocessed collection.
For Each x In UnProcessed
If Len(dblocal.TableDefs(x).Connect) > 0 Then
For Each y In dbbackend.TableDefs
If y.Name = x Then
Set tdlocal = dblocal.TableDefs(x)
tdlocal.Connect = ";DATABASE=" & strPath
tdlocal.RefreshLink
UnProcessed.Remove (x)
End If
Next
End If
Next
Exit_Relink:
Exit Function
Err_Relink:
If Err.Number = 3043 Then
MsgBox "Can not find the Master on the Network. Check that you have a good network connection."
Resume Exit_Relink
Else
Call ErrHandler(Err.Number, Err.Description, "Error in Relinktables")
Resume Exit_Relink
End If
End Function
Public Sub CheckifComplete()
Dim strTest As String, y As String, notfound As String, x
On Error GoTo Err_BeginLink
' If there are any names left in the unprocessed collection,
' then continue.
If UnProcessed.Count > 0 Then
For Each x In UnProcessed
notfound = notfound & x & Chr(13)
Next
' List the tables that have not yet been relinked.
y = MsgBox("The following tables were not found in " & _
Chr(13) & Chr(13) & strPath _
& ":" & Chr(13) & Chr(13) & notfound & Chr(13) & _
"Select another database that contains the additional tables?", _
vbQuestion + vbYesNo, "Tables not found")
If y = vbNo Then
Exit Sub
End If
' Bring the Common Dialog Control back up.
strPath = fGetFileName
strTest = strPath
If Len(strTest) = 0 Then ' File not found.
MsgBox "File not found. Please try again.", vbExclamation, _
"Link to new data file"
Exit Sub
End If
Debug.Print "Break"
Relinktables (strTest)
Else
Exit Sub
End If
CheckifComplete
Exit_BeginLink:
DoCmd.Echo True ' Just in case of error jump.
DoCmd.Hourglass False
Exit Sub
Err_BeginLink:
Debug.Print Err.Number
If Err.Number = 457 Then
ClearAll
Resume Next
End If
MsgBox Err.Number & ": " & Err.Description
Resume Exit_BeginLink
End Sub
Public Sub linkToMaster()
On Error GoTo errLbl:
'I have a table in the front end that has the path
'to the back end. This could be hard coded.
strPath = DLookup("BElocation", "tblDefault")
ReProcessTables
Exit Sub
errLbl:
Call ErrHandler(Err.Number, Err.Description, "LinkToMaster")
End Sub
Public Sub linkToReplica()
MsgBox "Pick the location of your replica database.", vbInformation, "Find Replica"
strPath = fGetFileName()
ReProcessTables
End Sub
Public Sub AppendAllTables()
Dim db As DAO.Database, x As Variant
Dim strTest As String
' Add names of all table with invalid links to the Unprocessed Collection.
Set db = CurrentDb
If Not UnProcessed Is Nothing Then
ClearAll
End If
For Each x In db.TableDefs
If Len(x.Connect) > 1 Then
' connect string exists, but file does not
UnProcessed.Add Item:=x.Name, Key:=x.Name
End If
Next
End Sub
Public Function ReProcessTables()
Dim strTest As String
On Error GoTo Err_BeginLink
' Call procedure to add all tables with broken links into a collection.
AppendAllTables
' Test for existence of file name\directory selected in Common Dialog Control.
strTest = strPath
On Error GoTo Err_BeginLink
If Len(strTest) = 0 Then ' File not found.
MsgBox "File not found. Please try again.", vbExclamation, "Link to new data file"
Exit Function
End If
' Begin relinking tables.
Relinktables (strTest)
' Check to see if all tables have been relinked.
CheckifComplete
DoCmd.Echo True, "Done"
If UnProcessed.Count < 1 Then
MsgBox "Linking to new back-end data file was successful."
Else
MsgBox "Not All back-end tables were successfully relinked."
End If
Exit_BeginLink:
DoCmd.Echo True
Exit Function
Err_BeginLink:
Debug.Print Err.Number
If Err.Number = 457 Then
ClearAll
Resume Next
End If
MsgBox Err.Number & ": " & Err.Description
Resume Exit_BeginLink
End Function
