DAO takes too much time to link tables

[Guest]

Hello,

I am trying to link some tables to a back-end database. But I have found two
problems:

1. It takes too much time to execute the code. To link 4 tables it takes
between 20 or 30 seconds!!

2. If I use a reference to CurrentDb I get the runtime error 3420: Object
invalid or no longer set.

I am wondering whether,

a) References to ADO libraries are affecting to the execution time (there is
also ADO code in this project which is being replaced by DAO code).
b) Using incorrectly the variable: CurrentDb.
c) I don't know what else: closing connections when they should not be
closed??.

I have attached the involvde piece of code.

Thank you in advance,

Dario.


Option Compare Database
Option Explicit


'Link the tables contained at the given query. Table names must be located
'at the first column of the query.
'Returns true if it is successful; otherwise, false.
Public Function LinkTables(ByVal sql As String, origin As String) As Boolean
Dim rst As DAO.Recordset
On Error GoTo LinkTables_Err
Set rst = CurrentDb.OpenRecordset(sql, dbOpenSnapshot)
While Not rst.EOF
'Stops linking!
If Not LinkTable(origin, rst(0)) Then
LinkTables = False
GoTo LinkTables_Exit
End If
rst.MoveNext
Wend
LinkTables = True

LinkTables_Exit:
If Not rst Is Nothing Then rst.Close
Set rst = Nothing
Exit Function

LinkTables_Err:
'Does not exist the table at the query.
If Err.Number = 3078 Then
MiscUtils.ShowError "The table given at the query does not exist:" &
vbCrLf & _
sql & vbCrLf & _
"Please review the query."
'Does not exist the column given at the query.
ElseIf Err.Number = 3061 Then
MiscUtils.ShowError "The specified columns at the query: " & vbCrLf & _
sql & vbCrLf & _
"don't exist. Please review the query."
Else
MiscUtils.ShowError Err.Number & " - " & Err.Description
End If

LinkTables = False
Resume LinkTables_Exit
End Function

Public Function LinkTable(origin As String, tbl As String) As Boolean
Dim dbOrigin As DAO.Database, dbs As DAO.Database
Dim tblOrigin As DAO.TableDef, tblLocal As DAO.TableDef
On Error GoTo LinkTable_Err
Dim success As Boolean
success = True

'I HAVE COMMENTED THIS LINE, BUT I HAVE TO "COPY" THIS OBJECT TO AVOID THE
ERROR 3420. AND IT SEEMS TO TAKE TO MUCH TIME, NOT JUST COPYING, ALSO WHEN IT
IS ASKED FOR A TABLE IN THE TABLEDEFS COLLECTION!!
' Set dbs = CurrentDb
Set dbOrigin = DBEngine.OpenDatabase(origin)
Set tblOrigin = dbOrigin.TableDefs(tbl)
'It is linking to a link!!
If tblOrigin.Connect <> "" Then
MiscUtils.ShowError "The table " & tbl & " is already a link to " & _
vbCrLf & origin & vbCrLf & _
"It is not possible to link to it!"

success = False
Else
'Ignores the error!may be this table does not exist in the current model yet.
On Error Resume Next
' Set tblLocal = dbs.TableDefs(tbl)
Set tblLocal = CurrentDb.TableDefs(tbl)
'Enables error-handling again.
On Error GoTo LinkTable_Err
Dim strConn As String
strConn = ";DATABASE=" & origin
If tblLocal Is Nothing Then
' Set tblLocal = dbs.CreateTableDef(tbl, 0, tbl, strConn)
' dbs.TableDefs.Append tblLocal
Set tblLocal = CurrentDb.CreateTableDef(tbl, 0, tbl, strConn)
CurrentDb.TableDefs.Append tblLocal
Else
'Refreshes the link!
If tblLocal.Connect <> "" Then
tblLocal.Connect = strConn
tblLocal.RefreshLink
Else
'Drops the table.
If RemoveTable(tbl, True) Then
Set tblLocal = CurrentDb.CreateTableDef(tbl, 0, tbl, strConn)
CurrentDb.TableDefs.Append tblLocal
' Set tblLocal = dbs.CreateTableDef(tbl, 0, tbl, strConn)
' dbs.TableDefs.Append tblLocal
Else
MiscUtils.ShowError "Table " & tbl & " could not be linked."
success = False
End If
End If
End If
End If

LinkTable = success

LinkTable_Exit:
If Not dbOrigin Is Nothing Then dbOrigin.Close
Set dbOrigin = Nothing
Set tblOrigin = Nothing
If Not dbs Is Nothing Then dbs.Close
Set dbs = Nothing
Set tblLocal = Nothing
Exit Function

LinkTable_Err:
'Origin element does not exist in the origin database.
If Err.Number = 3265 Then
MiscUtils.ShowError "La tabla " & tbl & " no existe en la base de datos:
" & _
vbCrLf & origin
Else
MiscUtils.ShowError Err.Number & " - " & Err.Description
End If
LinkTable = False
Resume LinkTable_Exit
End Function

 

[Allen Browne]

Instead of dropping and creating the links, just change the Connect property
of the TableDef.

Example code from Dev Ashish:
http://www.mvps.org/access/tables/tbl0009.htm
Or if the back end and front end are in the same folder:
http://allenbrowne.com/ser-13.html

As a further suggestion, OpenDatabase on the back end before linking:
dim dbData as DAO.Database
Set dbData = OpenDatabase(origin)
'the rest of your relinking code in here.
dbData.Close
Set dbData = Nothing
Although you do not actually use this dbData object, just holding the back
end open speeds the relinking up.

 

[Guest]

I have followed your tips and the relinking process is incredibly quite
faster than before.

But I still have a doubt, sometimes I don't only refresh links to tables, I
also replace tables from the model by links!Therefore, the process that I
follow to replace these tables is dropping them and creating the links. Is it
possible just to change the properties Connect and SourceTableName instead of
dropping them??

I will try!

Thanks a lot for your help!

Dario.

 

[Guest]

I have tried to replace a table by a link just changing the properties
Connect and SourceTableName and it raises an error because the name is the
same (and it must have the same name). Then, I have to drop it first.

Dario.

 

[david epsom dot com dot au]

The SourceTableName is an updatable property, like the Connect value.

It shouldn't take so long to create a new tabledef.

You should open the remote database first, (use opendatabase)
and keep it open until you have finished re-linking.

(david)