Hi All,
I've got a situation where I am developing an Access 97 app for a client,
and am in the "beta testing" stage.
I have split the app up, using the DB splitter, into front-end /back-end
for the usual reason ... so I can mess with form/report revisions. Since
splitting, I've had issues with re-linking the tables ... as it relates to
the completetely different "My Documents"
data paths on several different Win98 / Win XP computers.
To compound the problem (well at least *annoyance*) I had also linked a
couple of tables to another, totally seperate MDB that contains cummulative
sales data etc from our store. I found Dev's code at
http://www.mvps.org/access/tables/tbl0009.htm , and also tried the code from
Solutions.MDB, and tried to implement one or the other of them.
I found however, that both of them appear to be an "all-or-nothing"
approach. As soon as the code faults on a non-linked table it exits the
function ... leaving you with no idea about which (if any) table links have
been successfully refreshed.
I must admit that Dev's code intimidates me a little ... he's just so much
more advanced than I am... but I attempted "hacking" it a little to see if I
could get the results I want. What I have seems to work now, and re-links
all but the one table, but I'm thinking that surely someone has encountered
this situation before and has come up with something more elegant.???
P.S. I am the guy that will be re-linking tables, so I'm not too concerned
about the ease-of use factor.
Here's my "hack" version of Dev's code:
'***************** Code Start ***************
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' (Ooops ... Sorry Dev ... "hacked" by Don L
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'
Function fRefreshLinks() As Boolean
Dim strMsg As String, collTbls As Collection
Dim strFailedMsg As String 'DL
Dim strListFailed As String 'DL
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
Dim intCounter As Integer 'DL
intCounter = 0 'DL
Dim intTotalCount As Integer 'DL
intTotalCount = 0 'DL
Const cERR_USERCANCEL = vbObjectError + 1000
Const cERR_NOREMOTETABLE = vbObjectError + 2000
On Local Error GoTo fRefreshLinks_Err
If MsgBox("Are you sure you want to reconnect all Access tables?", _
vbQuestion + vbYesNo, "Please confirm...") = vbNo Then Err.Raise
cERR_USERCANCEL
'First get all linked tables in a collection
Set collTbls = fGetLinkedTables
intTotalCount = collTbls.Count
'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
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
'EXACTLY!!! DL
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
intCounter = intCounter + 1 'DL
Else
Err.Raise cERR_NOREMOTETABLE
End If
End If
NextTable: 'DL
Next
fRefreshLinks = True
varRet = SysCmd(acSysCmdClearStatus)
'MsgBox "All Access tables were successfully reconnected.", _
vbInformation + vbOKOnly, _
"Success"
strMsg = intCounter 'DL
strMsg = strMsg & " of "
strMsg = strMsg & intTotalCount
strMsg = strMsg & " tables have been sucessfully re-linked." & vbCrLf
fRefreshLinks_End:
If Len(strFailedMsg) > 0 And Len(strListFailed) > 0 Then 'DL
strMsg = strMsg & vbCrLf & strFailedMsg
End If
MsgBox (strMsg) 'DL
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:
If Len(strListFailed) > 0 Then 'DL
strListFailed = strListFailed & strTbl & vbCrLf
Else
strListFailed = strTbl
End If
If Len(strFailedMsg) > 0 Then 'DL
'Do Nothing
Else
strFailedMsg = "The following table(s): " & vbCrLf
strFailedMsg = strFailedMsg & strListFailed & vbCrLf &
vbCrLf
strFailedMsg = strFailedMsg & "could not be found in the
database:"
strFailedMsg = strFailedMsg & vbCrLf & dbLink.Name
End If
'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
Resume NextTable 'DL
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
