Article ID: 181076
Article Last Modified on 1/22/2007
Form: frmNewDataFile
--------------------------
Text box:
Name: txtFileName
Width: 3"
Common Dialog control:
Name: xDialog
Command button:
Name: cmdBrowse
Caption: Browse...
OnClick: =Browse()
Command button:
Name: cmdLinkNew
Caption: Refresh Links
OnClick: =Processtables()
Command button:
Name: cmdCancel
Caption: Cancel
Cancel: Yes
Private Sub cmdCancel_Click()
On Error GoTo Err_cmdCancel_Click
MsgBox "Link to new back-end cancelled", vbExclamation, _
"Cancel Refresh Link" ' Give a warning of cancellation.
DoCmd.Close acForm, Me.Name ' Close the form.
Exit_cmdCancel_Click:
Exit Sub
Err_cmdCancel_Click:
MsgBox Err.Description
Resume Exit_cmdCancel_Click
End Sub
Option Compare Database
Dim UnProcessed As New Collection
Option Explicit
Public Function Browse()
' Prompts user for back-end database file name.
On Error GoTo Err_Browse
Dim strFilename As String
Dim oDialog As Object
Set oDialog = [Forms]![frmNewDatafile]!xDialog.Object
With oDialog ' Ask for new file location.
.DialogTitle = "Please Select New Data File"
.Filter = "Access Database(*.mdb;*.mda;*.mde;*.mdw)|" & _
"*.mdb; *.mda; *.mde; *.mdw|All(*.*)|*.*"
.FilterIndex = 1
.ShowOpen
' If user responded, put selection into text box on form.
If Len(.FileName) > 0 Then _
[Forms]![frmNewDatafile]![txtFileName] = .FileName
End With
Exit_Browse:
Exit Function
Err_Browse:
MsgBox Err.Description
Resume Exit_Browse
End Function
Public Sub AppendTables()
Dim db As Database, x As Variant
' Add all linked table names into the Unprocessed Collection.
Set db = CurrentDb
ClearAll
For Each x In db.TableDefs
If Len(x.Connect) > 1 Then
UnProcessed.Add Item:=x.Name, key:=x.Name
End If
Next
End Sub
Public Function ProcessTables()
Dim strTest As String
On Error GoTo Err_BeginLink
' Call procedure to add all linked tables into a collection.
AppendTables
' Test for existence of file name\directory selected in
' Common Dialog Control.
strTest = Dir([Forms]![frmNewDatafile]![txtFileName])
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
DoCmd.Close acForm, [Forms]![frmNewDatafile].Name
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.Description
Resume Exit_BeginLink
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 Database, dblocal As Database, ws As Workspace, _
x, y
Dim tdlocal As 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=" & _
Trim([Forms]![frmNewDatafile]![txtFileName])
tdlocal.RefreshLink
UnProcessed.Remove (x)
End If
Next
End If
Next
Exit_Relink:
Exit Function
Err_Relink:
MsgBox Err.Description
Resume Exit_Relink
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) & [Forms]![frmNewDatafile]!txtFileName _
& ":" & 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.
Browse
strTest = Dir([Forms]![frmNewDatafile]![txtFileName])
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.Description
Resume Exit_BeginLink
End Sub
Linking to new back-end data file was successful.
Private Sub Form_Open(Cancel As Integer)
' Tests a linked table for valid back-end.
On Error GoTo Err_Form_Open
Dim strTest As String, db As Database
Dim td As TableDef
Set db = CurrentDb
For Each td In db.TableDefs
If Len(td.Connect) > 0 Then ' Is a linked table.
On Error Resume Next ' Turn off error trap.
strTest = Dir(Mid(td.Connect, 11)) ' Check file name.
On Error GoTo err_Form_Open ' Turn on error trap.
If Len(strTest) = 0 Then ' No matching file.
If MsgBox("Couldn't find the back-end file " & _
Mid(td.Connect, 11) & ". Please choose new data _
file.", _
vbExclamation + vbOKCancel + vbDefaultButton1, _
"Can't find backend data file.") = vbOK Then
DoCmd.OpenForm "frmNewDataFile" ' Open prompt form.
Else
MsgBox "The linked tables can't find their source. " & _
"Please log onto network and restart the application."
End If
End If
End If
Next ' Loop to next tabledef.
DoCmd.Close acForm, Me.Name
Exit_Form_Open:
Exit Sub
Err_Form_Open:
MsgBox "Oops! " & Error.Description
Resume Exit_Form_Open
End Sub
Couldn't find the back-end file <Database Name>. Please choose new data file.
The linked tables can't find their source. Please log onto network and restart the application.
154397 ADT/ODE How to Modify RefreshTableLinks Module in Solutions.mdb
Additional query words: inf relink reattach reconnect refresh link attach connect ADT ODE
Keywords: kbhowto kbprogramming KB181076