Christopher Hawkins
clh at christopherhawkins.com
Thu Jun 5 14:36:08 CDT 2003
Holy cow. I'll give that a try!
-C-
---- Original Message ----
From: jeffrey.demulling at usbank.com
To: accessd at databaseadvisors.com,
Subject: Re: [AccessD] Fast back-end relinking?
Date: Thu, 5 Jun 2003 14:22:00 -0500
>Call fRefreshLinks
>
>Option Compare Database
>Option Explicit
>
>Function fRefreshLinks() As Boolean
>Dim strMsg As String, collTbls As Collection
>Dim i As Integer, strDBPath As String, strTbl As String
>Dim dbCurr As Database, dbLink As Database
>Dim tdfLocal As TableDef
>Dim varRet As Variant
>Dim strNewPath As String
>
>Const cERR_USERCANCEL = vbObjectError + 1000
>Const cERR_NOREMOTETABLE = vbObjectError + 2000
>
> On Local Error GoTo fRefreshLinks_Err
>
>
> 'First get all linked tables in a collection
> Set collTbls = fGetLinkedTables
>
> 'now link all of them
> Set dbCurr = CurrentDb
>
> 'strMsg = "Do you wish to specify a different path for the Access
>Tables?"
>'If MsgBox(strMsg, vbQuestion + vbYesNo, "Alternate data source...")
>=
>vbYes
>'Then strNewPath = fGetMDBName("Please select a new datasource")
>Else
>'strNewPath = vbNullString End If
>strNewPath = GetDataLoc & GetDataName
>
> For i = collTbls.Count To 1 Step -1
> strDBPath = fParsePath(collTbls(i))
> strTbl = fParseTable(collTbls(i))
> varRet = SysCmd(acSysCmdSetStatus, "Now linking '" & strTbl
>&
>"'....")
> If left$(strDBPath, 4) = "ODBC" Then
> 'ODBC Tables
> 'ODBC Tables handled separately
> ' Set tdfLocal = dbCurr.TableDefs(strTbl)
> ' With tdfLocal
> ' .Connect = pcCONNECT
> ' .RefreshLink
> ' collTbls.Remove (strTbl)
> ' End With
> Else
> If strNewPath <> vbNullString Then
> 'Try this first
> strDBPath = strNewPath
> Else
> If Len(Dir(strDBPath)) = 0 Then
> 'File Doesn't Exist, call GetOpenFileName
> strDBPath = fGetMDBName("'" & strDBPath & "' not
>found.")
> If strDBPath = vbNullString Then
> 'user pressed cancel
> Err.Raise cERR_USERCANCEL
> End If
> End If
> End If
>
> 'backend database exists
> 'putting it here since we could have
> 'tables from multiple sources
> Set dbLink = DBEngine(0).OpenDatabase(strDBPath)
>
> 'check to see if the table is present in dbLink
> strTbl = fParseTable(collTbls(i))
> If fIsRemoteTable(dbLink, strTbl) Then
> 'everything's ok, reconnect
> Set tdfLocal = dbCurr.TableDefs(strTbl)
> With tdfLocal
> .Connect = ";Database=" & strDBPath
> .RefreshLink
> collTbls.Remove (.name)
> End With
> Else
> Err.Raise cERR_NOREMOTETABLE
> End If
> End If
> Next
> fRefreshLinks = True
> varRet = SysCmd(acSysCmdClearStatus)
> MsgBox "All Access tables were successfully reconnected.",
>vbInformation + vbOKOnly, "Success"
>fRefreshLinks_End:
> Set collTbls = Nothing
> Set tdfLocal = Nothing
> Set dbLink = Nothing
> Set dbCurr = Nothing
> Exit Function
>fRefreshLinks_Err:
> fRefreshLinks = False
> Select Case Err
> Case 3059:
>
> Case cERR_USERCANCEL:
> MsgBox "No Database was specified, couldn't link
>tables.", _
> vbCritical + vbOKOnly, _
> "Error in refreshing links."
> Resume fRefreshLinks_End
> Case cERR_NOREMOTETABLE:
> MsgBox "Table '" & strTbl & "' was not found in the
>database"
>& _
> vbCrLf & dbLink.name & ". Couldn't refresh
>links", _
> vbCritical + vbOKOnly, _
> "Error in refreshing links."
> Resume fRefreshLinks_End
> Case Else:
> strMsg = "Error Information..." & vbCrLf & vbCrLf
> strMsg = strMsg & "Function: fRefreshLinks" & vbCrLf
> strMsg = strMsg & "Description: " & Err.Description &
>vbCrLf
> strMsg = strMsg & "Error #: " & Format$(Err.Number) &
>vbCrLf
> MsgBox strMsg, vbOKOnly + vbCritical, "Error"
> Resume fRefreshLinks_End
> End Select
>End Function
>
>Function fIsRemoteTable(dbRemote As Database, strTbl As String) As
>Boolean
>Dim tdf As TableDef
> On Error Resume Next
> Set tdf = dbRemote.TableDefs(strTbl)
> fIsRemoteTable = (Err = 0)
> Set tdf = Nothing
>End Function
>
>Function fGetMDBName(strIn As String) As String
>'Calls GetOpenFileName dialog
>Dim strFilter As String
>
> 'strFilter = ahtAddFilterItem(strFilter, "Access
>Database(*.mdb;*.mda;*.mde;*.mdw) ", "*.mdb; *.mda; *.mde; *.mdw")
> 'strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)",
>"*.*")
> 'fGetMDBName = ahtCommonFileOpenSave(Filter:=strFilter,
>OpenFile:=True, DialogTitle:=strIn, Flags:=ahtOFN_HIDEREADONLY)
>End Function
>
>Function fGetLinkedTables() As Collection
>'Returns all linked tables
> Dim collTables As New Collection
> Dim tdf As TableDef, db As Database
> Set db = CurrentDb
> db.TableDefs.Refresh
> For Each tdf In db.TableDefs
> With tdf
> If Len(.Connect) > 0 Then
> If left$(.Connect, 4) = "ODBC" Then
> ' collTables.Add Item:=.Name & ";" & .Connect,
>KEY:=.Name
> 'ODBC Reconnect handled separately
> Else
> collTables.Add Item:=.name & .Connect, KEY:=.name
> End If
> End If
> End With
> Next
> Set fGetLinkedTables = collTables
> Set collTables = Nothing
> Set tdf = Nothing
> Set db = Nothing
>End Function
>
>Function fParsePath(strIn As String) As String
> If left$(strIn, 4) <> "ODBC" Then
> fParsePath = right(strIn, Len(strIn) _
> - (InStr(1, strIn, "DATABASE=") + 8))
> Else
> fParsePath = strIn
> End If
>End Function
>
>Function fParseTable(strIn As String) As String
> fParseTable = left$(strIn, InStr(1, strIn, ";") - 1)
>End Function
>
>
>
>
>
>"Christopher Hawkins" <clh at christopherhawkins.com>
>Sent by: accessd-bounces at databaseadvisors.com
>06/05/2003 02:06 PM
>Please respond to accessd
>
>
> To: accessd at databaseadvisors.com
> cc:
> Subject: [AccessD] Fast back-end relinking?
>
>
>First off: I have seen (and used) Tribble's Back-End relinker
>before. That's not what I need in this case.
>
>I have inherited an app with some back-end relinking code that is
>very slow. I've seen programmatic implementations of a table link
>that linked up very quickly, as quickly as using File > Get External
>Data > Link Tables. The one I'm dealing with takes many times as
>long.
>
>There is a table in my db called tblTable. It contains the name and
>path of every table in the database. The table is used in the
>following code:
>
>***START***
>
>Dim db As DAO.Database
>Dim tbl As DAO.TableDef
>Set db = CurrentDb
>Dim rsData As DAO.Recordset
>
>
> Set rsData = db.OpenRecordset("SELECT * FROM tblTable")
>
> rsData.MoveFirst
>
> Do Until rsData.EOF = True
> Set tbl = db.CreateTableDef(rsData("TableName"))
> Debug.Print "Now attaching " & tbl.Name & "..."
> tbl.Connect = (";DATABASE=" & rsData("Path"))
> tbl.SourceTableName = rsData("TableName")
> db.TableDefs.Append tbl
> rsData.MoveNext
> Loop
>
>db.Close
>
>***END***
>
>All the lag takes place when running the 'db.TableDefs.append tbl'
>line.
>
>Is there any way to speed this process up? I've seen it done more
>quickly before, I just didn't get to see the actual code. :(
>
>-Christopher-
>
>_______________________________________________
>AccessD mailing list
>AccessD at databaseadvisors.com
>http://databaseadvisors.com/mailman/listinfo/accessd
>Website: http://www.databaseadvisors.com
>
>
>
>