By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,665 Members | 1,382 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,665 IT Pros & Developers. It's quick & easy.

Relinking tables to Multiple "Back-ends" (using multiple OS's!)

P: n/a
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

Nov 13 '05 #1
Share this Question
Share on Google+
6 Replies


P: n/a
On Fri, 30 Jul 2004 23:45:07 GMT, "Don Leverton" <My*****@Telus.Net>
wrote:

From this code, or the Solutions code, you can extract a function that
can refresh ONE table (let's call it LinkOneTable). Then write a
front-end function for that. Air-code might look like this:
dim varTablesInBackendOne as variant
dim varTablesInBackendTwo as variant
dim varTable as variant

varTablesInBackendOne = Array("tblOne", "tblTwo")
varTablesInBackendTwo = Array("tblThree", "tblFour")

for each varTable in varTablesInBackendOne
LinkOneTable(varTable)
next varTable

for each varTable in varTablesInBackendTwo
LinkOneTable(varTable)
next varTable
I noticed that in your code you're asking the user if they want to
choose a new backend. That's OK, just modify my code to (again, air
code):
strNewPath= fGetMDBName("Please select a new datasource for set one")
for each varTable in varTablesInBackendOne
LinkOneTable(varTable, strNewPath)
next varTable

strNewPath= fGetMDBName("Please select a new datasource for set two")
for each varTable in varTablesInBackendTwo
LinkOneTable(varTable, strNewPath)
next varTable
A more common approach is to test a link, and only pop the question
for the new backend location if not found. In that case write:
On error resume next
dbCurr.Tabledefs(varTablesInBackendOne(0)).Refresh Link
on error goto 0
if err.number<>0 then
strNewPath= fGetMDBName("Please select a new datasource for set
one")
for each varTable in varTablesInBackendOne
LinkOneTable(varTable, strNewPath)
next varTable
endif

On error resume next
dbCurr.Tabledefs(varTablesInBackendTwo(0)).Refresh Link
on error goto 0
if err.number<>0 then
strNewPath= fGetMDBName("Please select a new datasource for set
two")
for each varTable in varTablesInBackendTwo
LinkOneTable(varTable, strNewPath)
next varTable
endif

-Tom.

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


Nov 13 '05 #2

P: n/a
Hi Tom,

Thanks for the reply...
I *thought* I had a pretty good grasp of what you were saying, but I've been
fooling with this all night, and can't get it to work :(
I did try both methods, as you will see by the commented code.

Would you mind having another look? I'm sure that I've mis-understood
something.

TIA,
Don

************************************************** ***************
Option Compare Database
Option Explicit

Function ListLinkedTables()
'I used this to build my Arrays

Dim strListOne As String
Dim strListTwo As String
Dim tdf As DAO.TableDef
On Error Resume Next

' Loop through all tables in database.
For Each tdf In CurrentDb.TableDefs
' If the Connect property is non-empty, the table is linked
If Len(tdf.Connect) > 0 Then

Debug.Print tdf.Connect

If InStr(1, tdf.Connect, "Mck2004_be.MDB") Then
If Len(strListOne) > 0 Then
strListOne = strListOne & chr(34) & tdf.Name & chr(34) & ", "
Else
strListOne = chr(34) & tdf.Name & chr(34) & ", "
End If
End If

If InStr(1, tdf.Connect, "TamsDemand.MDB") Then
If Len(strListTwo) > 0 Then
strListTwo = strListTwo & chr(34) & tdf.Name & chr(34) & ", "
Else
strListTwo = chr(34) & tdf.Name & chr(34) & ", "
End If
End If
End If
Next tdf

Debug.Print strListOne
Debug.Print strListTwo

Set tdf = Nothing
End Function

Function LinkOneTable(tdf As Variant, MyPath As String) As Boolean
On Error Resume Next
' If the Connect property is non-empty, the table is linked
If Len(tdf.Connect) > 0 Then
tdf.Connect = ";DATABASE=" & MyPath
Err.Clear
tdf.RefreshLink ' Re-link the table.
If Err Then
LinkOneTable = False '*** This function seems to
always return False ***
Exit Function
End If
End If
Set tdf = Nothing
LinkOneTable = True ' All links have been refreshed.
End Function
Public Function TestRefreshLinks()
Dim Result
Dim strNewPath1 As String
Dim strNewPath2 As String
strNewPath1 = fGetMDBName("Please select a new datasource for set ONE ")
strNewPath2 = fGetMDBName("Please select a new datasource for set TWO ")

Dim varTablesInBackendOne As Variant
Dim varTablesInBackendTwo As Variant
Dim varTable As Variant

varTablesInBackendOne = Array("tblCompanyInformation", "tblContacts",
"tblContactTypes", "tblDailyQuote", "tblInfoData", "tblInfoType",
"tblJoinSupplier", "tblLabor", "tblLaborMenu", "tblLocation",
"tblPartsInventory", "tblPricing", "tblQuotations", "tblRepairOrders",
"tblStkAdjust", "tblSubContact", "tblTechnicians", "tblTransactions",
"tblVehicles")

varTablesInBackendTwo = Array("tblDemand") 'Just one table in this array.

For Each varTable In varTablesInBackendOne
Result = LinkOneTable(varTable, strNewPath1)
Next varTable

For Each varTable In varTablesInBackendTwo
Result = LinkOneTable(varTable, strNewPath2)
Next varTable

'*************************************************
' On Error Resume Next
' CurrentDb.TableDefs(varTablesInBackendOne(0)).Refr eshLink
' On Error GoTo 0
' If Err.Number <> 0 Then
' strNewPath = fGetMDBName("Please select a new datasource for set one ")
' For Each varTable In varTablesInBackendOne
' Result = LinkOneTable(varTable, strNewPath)
' Next varTable
' End If
'
' On Error Resume Next
' CurrentDb.TableDefs(varTablesInBackendTwo(0)).Refr eshLink
' On Error GoTo 0
' If Err.Number <> 0 Then
' strNewPath = fGetMDBName("Please select a new datasource for set two ")
' For Each varTable In varTablesInBackendTwo
' Result = LinkOneTable(varTable, strNewPath)
' Next varTable
' End If
'*************************************************
End Function

************************************************** ***************
"Tom van Stiphout" <no*************@cox.net> wrote in message
news:9b********************************@4ax.com...
On Fri, 30 Jul 2004 23:45:07 GMT, "Don Leverton" <My*****@Telus.Net>
wrote:

From this code, or the Solutions code, you can extract a function that
can refresh ONE table (let's call it LinkOneTable). Then write a
front-end function for that. Air-code might look like this:
dim varTablesInBackendOne as variant
dim varTablesInBackendTwo as variant
dim varTable as variant

varTablesInBackendOne = Array("tblOne", "tblTwo")
varTablesInBackendTwo = Array("tblThree", "tblFour")

for each varTable in varTablesInBackendOne
LinkOneTable(varTable)
next varTable

for each varTable in varTablesInBackendTwo
LinkOneTable(varTable)
next varTable
I noticed that in your code you're asking the user if they want to
choose a new backend. That's OK, just modify my code to (again, air
code):
strNewPath= fGetMDBName("Please select a new datasource for set one")
for each varTable in varTablesInBackendOne
LinkOneTable(varTable, strNewPath)
next varTable

strNewPath= fGetMDBName("Please select a new datasource for set two")
for each varTable in varTablesInBackendTwo
LinkOneTable(varTable, strNewPath)
next varTable
A more common approach is to test a link, and only pop the question
for the new backend location if not found. In that case write:
On error resume next
dbCurr.Tabledefs(varTablesInBackendOne(0)).Refresh Link
on error goto 0
if err.number<>0 then
strNewPath= fGetMDBName("Please select a new datasource for set
one")
for each varTable in varTablesInBackendOne
LinkOneTable(varTable, strNewPath)
next varTable
endif

On error resume next
dbCurr.Tabledefs(varTablesInBackendTwo(0)).Refresh Link
on error goto 0
if err.number<>0 then
strNewPath= fGetMDBName("Please select a new datasource for set
two")
for each varTable in varTablesInBackendTwo
LinkOneTable(varTable, strNewPath)
next varTable
endif

-Tom.

Nov 13 '05 #3

P: n/a
All you're doing is passing the name of the table to your routine
LinkOneTable, yet you're treating it as though it's a table object.

--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no e-mails, please!)

"Don Leverton" <le****************@telusplanet.net> wrote in message
news:igGOc.2572$yT2.800@clgrps13...
Hi Tom,

Thanks for the reply...
I *thought* I had a pretty good grasp of what you were saying, but I've been fooling with this all night, and can't get it to work :(
I did try both methods, as you will see by the commented code.

Would you mind having another look? I'm sure that I've mis-understood
something.

TIA,
Don

************************************************** ***************
Option Compare Database
Option Explicit

Function ListLinkedTables()
'I used this to build my Arrays

Dim strListOne As String
Dim strListTwo As String
Dim tdf As DAO.TableDef
On Error Resume Next

' Loop through all tables in database.
For Each tdf In CurrentDb.TableDefs
' If the Connect property is non-empty, the table is linked
If Len(tdf.Connect) > 0 Then

Debug.Print tdf.Connect

If InStr(1, tdf.Connect, "Mck2004_be.MDB") Then
If Len(strListOne) > 0 Then
strListOne = strListOne & chr(34) & tdf.Name & chr(34) & ", "
Else
strListOne = chr(34) & tdf.Name & chr(34) & ", "
End If
End If

If InStr(1, tdf.Connect, "TamsDemand.MDB") Then
If Len(strListTwo) > 0 Then
strListTwo = strListTwo & chr(34) & tdf.Name & chr(34) & ", "
Else
strListTwo = chr(34) & tdf.Name & chr(34) & ", "
End If
End If
End If
Next tdf

Debug.Print strListOne
Debug.Print strListTwo

Set tdf = Nothing
End Function

Function LinkOneTable(tdf As Variant, MyPath As String) As Boolean
On Error Resume Next
' If the Connect property is non-empty, the table is linked
If Len(tdf.Connect) > 0 Then
tdf.Connect = ";DATABASE=" & MyPath
Err.Clear
tdf.RefreshLink ' Re-link the table.
If Err Then
LinkOneTable = False '*** This function seems to
always return False ***
Exit Function
End If
End If
Set tdf = Nothing
LinkOneTable = True ' All links have been refreshed.
End Function
Public Function TestRefreshLinks()
Dim Result
Dim strNewPath1 As String
Dim strNewPath2 As String
strNewPath1 = fGetMDBName("Please select a new datasource for set ONE ")
strNewPath2 = fGetMDBName("Please select a new datasource for set TWO ")

Dim varTablesInBackendOne As Variant
Dim varTablesInBackendTwo As Variant
Dim varTable As Variant

varTablesInBackendOne = Array("tblCompanyInformation", "tblContacts",
"tblContactTypes", "tblDailyQuote", "tblInfoData", "tblInfoType",
"tblJoinSupplier", "tblLabor", "tblLaborMenu", "tblLocation",
"tblPartsInventory", "tblPricing", "tblQuotations", "tblRepairOrders",
"tblStkAdjust", "tblSubContact", "tblTechnicians", "tblTransactions",
"tblVehicles")

varTablesInBackendTwo = Array("tblDemand") 'Just one table in this array.

For Each varTable In varTablesInBackendOne
Result = LinkOneTable(varTable, strNewPath1)
Next varTable

For Each varTable In varTablesInBackendTwo
Result = LinkOneTable(varTable, strNewPath2)
Next varTable

'*************************************************
' On Error Resume Next
' CurrentDb.TableDefs(varTablesInBackendOne(0)).Refr eshLink
' On Error GoTo 0
' If Err.Number <> 0 Then
' strNewPath = fGetMDBName("Please select a new datasource for set one ") ' For Each varTable In varTablesInBackendOne
' Result = LinkOneTable(varTable, strNewPath)
' Next varTable
' End If
'
' On Error Resume Next
' CurrentDb.TableDefs(varTablesInBackendTwo(0)).Refr eshLink
' On Error GoTo 0
' If Err.Number <> 0 Then
' strNewPath = fGetMDBName("Please select a new datasource for set two ") ' For Each varTable In varTablesInBackendTwo
' Result = LinkOneTable(varTable, strNewPath)
' Next varTable
' End If
'*************************************************
End Function

************************************************** ***************
"Tom van Stiphout" <no*************@cox.net> wrote in message
news:9b********************************@4ax.com...
On Fri, 30 Jul 2004 23:45:07 GMT, "Don Leverton" <My*****@Telus.Net>
wrote:

From this code, or the Solutions code, you can extract a function that
can refresh ONE table (let's call it LinkOneTable). Then write a
front-end function for that. Air-code might look like this:
dim varTablesInBackendOne as variant
dim varTablesInBackendTwo as variant
dim varTable as variant

varTablesInBackendOne = Array("tblOne", "tblTwo")
varTablesInBackendTwo = Array("tblThree", "tblFour")

for each varTable in varTablesInBackendOne
LinkOneTable(varTable)
next varTable

for each varTable in varTablesInBackendTwo
LinkOneTable(varTable)
next varTable
I noticed that in your code you're asking the user if they want to
choose a new backend. That's OK, just modify my code to (again, air
code):
strNewPath= fGetMDBName("Please select a new datasource for set one")
for each varTable in varTablesInBackendOne
LinkOneTable(varTable, strNewPath)
next varTable

strNewPath= fGetMDBName("Please select a new datasource for set two")
for each varTable in varTablesInBackendTwo
LinkOneTable(varTable, strNewPath)
next varTable
A more common approach is to test a link, and only pop the question
for the new backend location if not found. In that case write:
On error resume next
dbCurr.Tabledefs(varTablesInBackendOne(0)).Refresh Link
on error goto 0
if err.number<>0 then
strNewPath= fGetMDBName("Please select a new datasource for set
one")
for each varTable in varTablesInBackendOne
LinkOneTable(varTable, strNewPath)
next varTable
endif

On error resume next
dbCurr.Tabledefs(varTablesInBackendTwo(0)).Refresh Link
on error goto 0
if err.number<>0 then
strNewPath= fGetMDBName("Please select a new datasource for set
two")
for each varTable in varTablesInBackendTwo
LinkOneTable(varTable, strNewPath)
next varTable
endif

-Tom.


Nov 13 '05 #4

P: n/a
On Sat, 31 Jul 2004 05:39:26 GMT, "Don Leverton"
<le****************@telusplanet.net> wrote:

Pretty good work so far, Don.

Doug is right. Here are a few points:
Function LinkOneTable(tdf As Variant, MyPath As String) As Boolean
should be changed to:
Function LinkOneTable(tdf As Tabledef, MyPath As String) As Boolean
and then called using:
Result = LinkOneTable(dbCurr.Tabledefs(varTable), strNewPath1)

What you take away from this is that you always want the strongest
data type possible. Variant is the sloppiest data type, so you use it
as little as possible.

-Tom.

Hi Tom,

Thanks for the reply...
I *thought* I had a pretty good grasp of what you were saying, but I've been
fooling with this all night, and can't get it to work :(
I did try both methods, as you will see by the commented code.

Would you mind having another look? I'm sure that I've mis-understood
something.

TIA,
Don

************************************************* ****************
Option Compare Database
Option Explicit

Function ListLinkedTables()
'I used this to build my Arrays

Dim strListOne As String
Dim strListTwo As String
Dim tdf As DAO.TableDef
On Error Resume Next

' Loop through all tables in database.
For Each tdf In CurrentDb.TableDefs
' If the Connect property is non-empty, the table is linked
If Len(tdf.Connect) > 0 Then

Debug.Print tdf.Connect

If InStr(1, tdf.Connect, "Mck2004_be.MDB") Then
If Len(strListOne) > 0 Then
strListOne = strListOne & chr(34) & tdf.Name & chr(34) & ", "
Else
strListOne = chr(34) & tdf.Name & chr(34) & ", "
End If
End If

If InStr(1, tdf.Connect, "TamsDemand.MDB") Then
If Len(strListTwo) > 0 Then
strListTwo = strListTwo & chr(34) & tdf.Name & chr(34) & ", "
Else
strListTwo = chr(34) & tdf.Name & chr(34) & ", "
End If
End If
End If
Next tdf

Debug.Print strListOne
Debug.Print strListTwo

Set tdf = Nothing
End Function

Function LinkOneTable(tdf As Variant, MyPath As String) As Boolean
On Error Resume Next
' If the Connect property is non-empty, the table is linked
If Len(tdf.Connect) > 0 Then
tdf.Connect = ";DATABASE=" & MyPath
Err.Clear
tdf.RefreshLink ' Re-link the table.
If Err Then
LinkOneTable = False '*** This function seems to
always return False ***
Exit Function
End If
End If
Set tdf = Nothing
LinkOneTable = True ' All links have been refreshed.
End Function
Public Function TestRefreshLinks()
Dim Result
Dim strNewPath1 As String
Dim strNewPath2 As String
strNewPath1 = fGetMDBName("Please select a new datasource for set ONE ")
strNewPath2 = fGetMDBName("Please select a new datasource for set TWO ")

Dim varTablesInBackendOne As Variant
Dim varTablesInBackendTwo As Variant
Dim varTable As Variant

varTablesInBackendOne = Array("tblCompanyInformation", "tblContacts",
"tblContactTypes", "tblDailyQuote", "tblInfoData", "tblInfoType",
"tblJoinSupplier", "tblLabor", "tblLaborMenu", "tblLocation",
"tblPartsInventory", "tblPricing", "tblQuotations", "tblRepairOrders",
"tblStkAdjust", "tblSubContact", "tblTechnicians", "tblTransactions",
"tblVehicles")

varTablesInBackendTwo = Array("tblDemand") 'Just one table in this array.

For Each varTable In varTablesInBackendOne
Result = LinkOneTable(varTable, strNewPath1)
Next varTable

For Each varTable In varTablesInBackendTwo
Result = LinkOneTable(varTable, strNewPath2)
Next varTable

'************************************************ *
' On Error Resume Next
' CurrentDb.TableDefs(varTablesInBackendOne(0)).Refr eshLink
' On Error GoTo 0
' If Err.Number <> 0 Then
' strNewPath = fGetMDBName("Please select a new datasource for set one ")
' For Each varTable In varTablesInBackendOne
' Result = LinkOneTable(varTable, strNewPath)
' Next varTable
' End If
'
' On Error Resume Next
' CurrentDb.TableDefs(varTablesInBackendTwo(0)).Refr eshLink
' On Error GoTo 0
' If Err.Number <> 0 Then
' strNewPath = fGetMDBName("Please select a new datasource for set two ")
' For Each varTable In varTablesInBackendTwo
' Result = LinkOneTable(varTable, strNewPath)
' Next varTable
' End If
'************************************************ *
End Function

************************************************* ****************
"Tom van Stiphout" <no*************@cox.net> wrote in message
news:9b********************************@4ax.com.. .
On Fri, 30 Jul 2004 23:45:07 GMT, "Don Leverton" <My*****@Telus.Net>
wrote:

From this code, or the Solutions code, you can extract a function that
can refresh ONE table (let's call it LinkOneTable). Then write a
front-end function for that. Air-code might look like this:
dim varTablesInBackendOne as variant
dim varTablesInBackendTwo as variant
dim varTable as variant

varTablesInBackendOne = Array("tblOne", "tblTwo")
varTablesInBackendTwo = Array("tblThree", "tblFour")

for each varTable in varTablesInBackendOne
LinkOneTable(varTable)
next varTable

for each varTable in varTablesInBackendTwo
LinkOneTable(varTable)
next varTable
I noticed that in your code you're asking the user if they want to
choose a new backend. That's OK, just modify my code to (again, air
code):
strNewPath= fGetMDBName("Please select a new datasource for set one")
for each varTable in varTablesInBackendOne
LinkOneTable(varTable, strNewPath)
next varTable

strNewPath= fGetMDBName("Please select a new datasource for set two")
for each varTable in varTablesInBackendTwo
LinkOneTable(varTable, strNewPath)
next varTable
A more common approach is to test a link, and only pop the question
for the new backend location if not found. In that case write:
On error resume next
dbCurr.Tabledefs(varTablesInBackendOne(0)).Refresh Link
on error goto 0
if err.number<>0 then
strNewPath= fGetMDBName("Please select a new datasource for set
one")
for each varTable in varTablesInBackendOne
LinkOneTable(varTable, strNewPath)
next varTable
endif

On error resume next
dbCurr.Tabledefs(varTablesInBackendTwo(0)).Refresh Link
on error goto 0
if err.number<>0 then
strNewPath= fGetMDBName("Please select a new datasource for set
two")
for each varTable in varTablesInBackendTwo
LinkOneTable(varTable, strNewPath)
next varTable
endif

-Tom.


Nov 13 '05 #5

P: n/a
Hi Tom / Doug,

Thanks fellas ... that, along with re-defining and setting the "dbCurr"
variable did it for me.

I'll continue to "tweak" this a little over the next few days, the re-post
the final code for the benefit of anyone else that encounters this.

What do you think of using the .FileSearch object (using .LookIn =
BrowseFolder("Find Database Directory") and .SearchSubFolders = True) to
automatically find (track down) the back-end file for each table if / when
the .RefreshLink fails?

Seeing as how we have constructed a function that re-links one table at a
time, couldn't I loop through the tabledefs collection and parse the file
names out of each tabledef's .Connect Property?

I'm hoping that this might do away with having to build the (static) table
arrays, and make this procedure somewhat universal.

I'm even thinking now that storing the TAMS data (tblPricing, tblDemand) on
a CD might be a good idea for a multitude of reasons... database size,
confidentiality, as well as keeping this data current and up-to-date.

Yup... I can see that this idea is going to keep me busy for a while! <grin>

Thanks again for the help thus far.
Don

"Tom van Stiphout" <no*************@cox.net> wrote in message
news:dd********************************@4ax.com...
On Sat, 31 Jul 2004 05:39:26 GMT, "Don Leverton"
<le****************@telusplanet.net> wrote:

Pretty good work so far, Don.

Doug is right. Here are a few points:
Function LinkOneTable(tdf As Variant, MyPath As String) As Boolean
should be changed to:
Function LinkOneTable(tdf As Tabledef, MyPath As String) As Boolean
and then called using:
Result = LinkOneTable(dbCurr.Tabledefs(varTable), strNewPath1)

What you take away from this is that you always want the strongest
data type possible. Variant is the sloppiest data type, so you use it
as little as possible.

-Tom.

Nov 13 '05 #6

P: n/a
To anyone who may be interested in this...

This really wasn't as tough as I thought it was going to be! (famous last
words?)

With the direction from Tom and Douglas (along with a bit clearer head
tonight) I messed around a little more and came up with this as a solution.
I had entertained the idea of using the .FileSearch object as either an
alternative or additional step, but decided against it.
I also considered "fancying this up" as Dev has with his code ... displaying
the progress in the status bar etc ... but decided I didn't have the time
or ambition for that either. <grin>

So anyway ... (knock on wood) it seems to be working ...

************************************************** *
'--------------------------------------------------------------------
Public Function fRelinkMultipleBackends()
'-------------------------------------------------
'Name: fRelinkMultipleBackends (Function)
'Purpose: Re-links attached tables on a
' one-by-one basis, deals with locating
' 'lost' MDB file links.
'Author: Don Leverton
'Date: July 31, 2004, 09:46:28 PM
'Called by: cmdRefreshLinks_Click() on frmSwitchboard
'Calls: LinkOneTable() function if .RefreshLink fails
'Inputs: None
'Output: Message that confirms / informs
'Requires: Dev's fGetMDBName() function and GetOpenFileName API from:
' http://www.mvps.org/access/tables/tbl0009.htm
'Thanks to: Tom van Stiphout, Douglas J. Steele and Dev Ashish
'-------------------------------------------------

Dim MyDB As DAO.Database
Set MyDB = CurrentDb
Dim tdf As DAO.TableDef

Dim intLinkedCount As Integer
Dim intSuccessCount As Integer

Dim strTable As String
Dim strNewPath As String
Dim Result As Boolean

Dim Msg As String
Dim CR As String
CR = vbCrLf

On Error Resume Next

' Loop through all tables in database.
For Each tdf In MyDB.TableDefs

If Len(tdf.Connect) > 0 Then ' If the Connect property is non-empty,
the table is linked
intLinkedCount = intLinkedCount + 1 'Get a count of linked tables
strTable = tdf.Name 'Get the linked table name
On Error Resume Next

tdf.RefreshLink 'Attempt to relink table using existing .Connect
property

If Err.Number <> 0 Then 'If RefreshLink fails...

Msg = ""
Msg = chr(39) & strTable & chr(39)
Msg = Msg & " needs to re-linked " & CR
Msg = Msg & "to it's 'back-end' MDB file" & CR & CR
Msg = Msg & "Please select it's location " & CR
Msg = Msg & "from the next dialog box."
MsgBox (Msg)

strNewPath = fGetMDBName("Please select a new datasource
for: " & strTable)
Result = LinkOneTable(MyDB.TableDefs(strTable), strNewPath)

If Result = True Then 'The re-linking of the table was
successful
intSuccessCount = intSuccessCount + 1
End If

Else
intSuccessCount = intSuccessCount + 1 'RefreshLink was
successful
End If

End If
Next tdf

Msg = ""
Msg = Msg & intSuccessCount & " of "
Msg = Msg & intLinkedCount & CR
Msg = Msg & "linked tables have been " & CR
Msg = Msg & "successfully re-linked."
MsgBox (Msg)

Set tdf = Nothing
Set MyDB = Nothing

End Function

'--------------------------------------------------------------------
Function LinkOneTable(tdf As TableDef, MyPath As String) As Boolean
'Debug.Print "Attempting to re-link " & tdf.Name
On Error Resume Next
' If the Connect property is non-empty, the table is linked
If Len(tdf.Connect) > 0 Then
tdf.Connect = ";DATABASE=" & MyPath
Err.Clear
tdf.RefreshLink ' Re-link the table.
If Err Then
LinkOneTable = False ' This attempt to re-link has failed.
Exit Function
End If
End If
Set tdf = Nothing
LinkOneTable = True ' This link has been succesfully refreshed.
End Function

************************************************** *

Don
"Don Leverton" <My*****@Telus.Net> wrote in message
news:cBROc.8656$cd2.682@clgrps12...
I'll continue to "tweak" this a little over the next few days, the re-post
the final code for the benefit of anyone else that encounters this.

Yup... I can see that this idea is going to keep me busy for a while! <grin>

Nov 13 '05 #7

This discussion thread is closed

Replies have been disabled for this discussion.