I have database. When a database is opened, it runs the code
below that link it with the tables in another
access database. The problem is once this code is
executed, and then if I opened a form,
it takes 10 minutes for the form to comes up.
When I remove this code, it only takes
about 5 seconds for the form to comes up with
all the correct data.
1) What could cause it to take so long ?
2) Does access automatically linked the database
when you open the database
to where writing code to link it would be
redundant and slow ?
//////////////////////////////////
Public Sub LinkDatabase(sLoc As String)
Dim myrs As DAO.Recordset
Dim sDirectory As String
Dim sDatabase As String
Dim sTable As String
Dim sLoc2 As String
Dim db As Database
'Dim td As TableDef
DoCmd.Hourglass True
'link all tables and save new database location
Set myrs = CurrentDb.OpenRecordset("tbl000TableLinks")
On Error GoTo Err_Link:
With myrs
While Not .EOF
If !TableDatabase = "AuditAssist_Support.mdb" Then
sDirectory = Application.CurrentProject.Path & "\"
sDatabase = "AuditAssist_Support.mdb"
sLoc2 = sDirectory & sDatabase
Else
sDirectory = GetDBDir(sLoc)
sDatabase = Dir(sLoc)
sLoc2 = sLoc
End If
Set db = DBEngine.Workspaces(0).OpenDatabase(sLoc2, False, False, "MS Access;PWD=13453")
'Import tables from the specified Access database.
'For Each td In db.TableDefs
' sTable = td.Name
sTable = !TableName
' If Left(sTable, 3) = "tbl" Then
'delete linked table
CurrentDb.TableDefs.Delete sTable
'link table
DoCmd.TransferDatabase acLink, "Microsoft Access", sLoc2, acTable, sTable, sTable
' End If
'Next
.Edit
!TableDirectory = sDirectory
!TableDatabase = sDatabase
.Update
.MoveNext
Wend
End With
CurrentDb.TableDefs.Refresh
Set myrs = Nothing
Set db = Nothing
'MsgBox "Linked tables have been refreshed!", vbExclamation, "System Setup"
DoCmd.Hourglass False
Exit Sub
Err_Link:
Set myrs = Nothing
Set db = Nothing
DoCmd.Hourglass False
Select Case Err.Number
Case 3265
'table does not exist, skip delete
Resume Next
Case 32755
'cancel common dialog
MsgBox "Linked tables have NOT been refreshed!", vbExclamation, "System Setup"
Case Else
MsgBox Err.Description, vbCritical, "Error"
DoCmd.Quit acQuitSaveNone
End Select
End Sub
below that link it with the tables in another
access database. The problem is once this code is
executed, and then if I opened a form,
it takes 10 minutes for the form to comes up.
When I remove this code, it only takes
about 5 seconds for the form to comes up with
all the correct data.
1) What could cause it to take so long ?
2) Does access automatically linked the database
when you open the database
to where writing code to link it would be
redundant and slow ?
//////////////////////////////////
Public Sub LinkDatabase(sLoc As String)
Dim myrs As DAO.Recordset
Dim sDirectory As String
Dim sDatabase As String
Dim sTable As String
Dim sLoc2 As String
Dim db As Database
'Dim td As TableDef
DoCmd.Hourglass True
'link all tables and save new database location
Set myrs = CurrentDb.OpenRecordset("tbl000TableLinks")
On Error GoTo Err_Link:
With myrs
While Not .EOF
If !TableDatabase = "AuditAssist_Support.mdb" Then
sDirectory = Application.CurrentProject.Path & "\"
sDatabase = "AuditAssist_Support.mdb"
sLoc2 = sDirectory & sDatabase
Else
sDirectory = GetDBDir(sLoc)
sDatabase = Dir(sLoc)
sLoc2 = sLoc
End If
Set db = DBEngine.Workspaces(0).OpenDatabase(sLoc2, False, False, "MS Access;PWD=13453")
'Import tables from the specified Access database.
'For Each td In db.TableDefs
' sTable = td.Name
sTable = !TableName
' If Left(sTable, 3) = "tbl" Then
'delete linked table
CurrentDb.TableDefs.Delete sTable
'link table
DoCmd.TransferDatabase acLink, "Microsoft Access", sLoc2, acTable, sTable, sTable
' End If
'Next
.Edit
!TableDirectory = sDirectory
!TableDatabase = sDatabase
.Update
.MoveNext
Wend
End With
CurrentDb.TableDefs.Refresh
Set myrs = Nothing
Set db = Nothing
'MsgBox "Linked tables have been refreshed!", vbExclamation, "System Setup"
DoCmd.Hourglass False
Exit Sub
Err_Link:
Set myrs = Nothing
Set db = Nothing
DoCmd.Hourglass False
Select Case Err.Number
Case 3265
'table does not exist, skip delete
Resume Next
Case 32755
'cancel common dialog
MsgBox "Linked tables have NOT been refreshed!", vbExclamation, "System Setup"
Case Else
MsgBox Err.Description, vbCritical, "Error"
DoCmd.Quit acQuitSaveNone
End Select
End Sub