Linking Tables Is Slow

[wtmckown]

I have an Access 2002 application (FE/BE) that has been in production for several years. Recently it developed an annoying problem when executing a startup routine that relinks the backend tables. The frontend and backend mdbs are on the same machine. There are 105 tables that are relinked using the docmd.transferdatabase ac link syntax and until recently, this happened in the blink of the eye. Now eack table link takes approximately one second and thus a couple of minutes is required to startup the app. The platform is W2K Server(sp4) and it is all patched up. I actually suspect that a recent MS update caused this problem somehow. I will post the code below for review. I tested this on my 2003 server and don't have the problem. It works fine on my XP machine as well.



Public Function LinkTables() As Boolean
On Error GoTo Err_LinkTables
Dim conLCS As ADODB.Connection
Dim lngTotal As Long
Dim sMessage As String
Dim iCnt As Integer
Dim rstLCS As ADODB.Recordset
Set conLCS = CurrentProject.Connection
Set rstLCS = New ADODB.Recordset
Set rstLCS.ActiveConnection = conLCS

strSQL = ""
strSQL = "Select sTableName From tblLinkedTables ;"
Set rstLCS = conLCS.Execute(strSQL)
lngTotal = DCount("*", "tblLinkedTables")

' Open the progress form and set its properties
DoCmd.OpenForm "frmProgress"
sMessage = "Ready to link to ODBC tables"
UpdateProgressMeter sMessage, 0, lngTotal

While Not rstLCS.EOF
iCnt = iCnt + 1
DoEvents

DoCmd.Echo True, "Linking " & rstLCS("sTableName") & "......"

' Update progress meter with info about current table
sMessage = "Linking table " & rstLCS("sTableName")
UpdateProgressMeter sMessage, iCnt, lngTotal

On Error Resume Next
CurrentDb.TableDefs.Delete rstLCS("sTableName")

On Error GoTo Err_LinkTables
DoCmd.TransferDatabase acLink, "Microsoft Access", _
Forms!frmGlobalVariables!txtgstrBackEndPath & Forms!frmGlobalVariables!txtgstrBackEndName, _
acTable, rstLCS("sTableName"), rstLCS("sTableName")



rstLCS.MoveNext
Wend

LinkTables = True

Exit_LinkTables:
On Error Resume Next
rstLCS.Close
Set rstLCS = Nothing
Set conLCS = Nothing
strSQL = ""
DoCmd.Close acForm, "frmProgress"
Exit Function

Err_LinkTables:
Dim lngError As Long, strErrorText As String
LinkTables = False
lngError = Err.Number
strErrorText = Err.Description
MsgBox Err.Number & " - " & strErrorText, vbOKOnly, "LCS Error"

strSQL = ""
strSQL = "Insert Into tblErrLogLocal(sObject,sRoutine,sErrorNumber,sErrorDescription,derrordate,iUser)" _
& " Values('basUtils','LinkTables'," & lngError & ",'" & JetSQLFixup(strErrorText) & "',#" _
& Now() & "#," & giCurrentUser & ");"
DoCmd.SetWarnings False
DoCmd.RunSQL (strSQL)
DoCmd.SetWarnings True

lngError = 0
strErrorText = ""

Resume Exit_LinkTables
End Function

 

[JerryKlmns]

Have you tried the DAO 3.6 TAbleDef to Relink or the ADOX way instead of the DoCmd.TransferDatabase acLink..... ?