J
jambaroo
Hi everyone,
I have some code which enables the user to relink tables
in my database based on filenames selected in a combo box
on a form. By clicking on a command button it runs the
Public Function ProcessTables() within the module.
However, I keep on getting the error message, 3024: Could
not find file '[filename]' and I can't understand why.
The code is as follows:-
Dim UnProcessed As New Collection
Public Sub AppendTables()
Dim db As DAO.Database, x As Variant
Dim strTest As String
' Add names of all tables 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
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.
strTest = Dir([Forms]![frmNewDataFile]![cboFileName])
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)
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.Number & ": " & 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 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
' 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]!
[cboFileName])
tdlocal.RefreshLink
UnProcessed.Remove (x)
End If
Next
End If
Next
Exit_Relink:
Exit Function
Err_Relink:
MsgBox Err.Number & ": " & Err.Description
Resume Exit_Relink
End Function
I have used debug/step into and I believe that the error
occurs at:
Set dbbackend = DBEngine(0).OpenDatabase(strFilename)
Could anyone shed any light on this matter? Your help
would greatly be appreciated.
Cheers!
I have some code which enables the user to relink tables
in my database based on filenames selected in a combo box
on a form. By clicking on a command button it runs the
Public Function ProcessTables() within the module.
However, I keep on getting the error message, 3024: Could
not find file '[filename]' and I can't understand why.
The code is as follows:-
Dim UnProcessed As New Collection
Public Sub AppendTables()
Dim db As DAO.Database, x As Variant
Dim strTest As String
' Add names of all tables 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
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.
strTest = Dir([Forms]![frmNewDataFile]![cboFileName])
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)
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.Number & ": " & 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 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
' 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]!
[cboFileName])
tdlocal.RefreshLink
UnProcessed.Remove (x)
End If
Next
End If
Next
Exit_Relink:
Exit Function
Err_Relink:
MsgBox Err.Number & ": " & Err.Description
Resume Exit_Relink
End Function
I have used debug/step into and I believe that the error
occurs at:
Set dbbackend = DBEngine(0).OpenDatabase(strFilename)
Could anyone shed any light on this matter? Your help
would greatly be appreciated.
Cheers!