Dev Ashish Relink Tables

[Steven]

I was trying to use this code by Dev Ashish

Down below in the code I put : ********Problem******** where I am first
noticing the problem develop
The code returns a strTbl for example of "TrialBalanceMS Access" and an
error will say:
"Table TrialBalanceMS Access" not found ... cannot relink

The tables actual name is "TrialBalance". Why is it adding MS Access onto
it. I am able to manually link the tables to the mdb just fine but I always
get this message when trying to use the code.

Thank you for your help.

Steven

'***************** Code Start ***************
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' 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 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

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

'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
MsgBox strDBPath
Set dbLink = DBEngine(0).OpenDatabase(strDBPath, False, False,
";PWD=FirstPwd")

'check to see if the table is present in dbLink
strTbl = fParseTable(collTbls(i))
********Problem********
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
'***************** Code End ***************

 

[Dirk Goldgar]

I was trying to use this code by Dev Ashish

Down below in the code I put : ********Problem******** where I am
first
noticing the problem develop
The code returns a strTbl for example of "TrialBalanceMS Access" and an
error will say:
"Table TrialBalanceMS Access" not found ... cannot relink

The tables actual name is "TrialBalance". Why is it adding MS Access onto
it. I am able to manually link the tables to the mdb just fine but I
always
get this message when trying to use the code.

Thank you for your help.

Steven

'***************** Code Start ***************
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' 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 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

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

'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
MsgBox strDBPath
Set dbLink = DBEngine(0).OpenDatabase(strDBPath, False, False,
";PWD=FirstPwd")

'check to see if the table is present in dbLink
strTbl = fParseTable(collTbls(i))
********Problem********
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
'***************** Code End ***************

Are your linked tables normal Access tables, or are they in some other file
format?

Please type the following into the Immediate window, press {Enter}, and post
the result:

?CurrentDb.TableDefs("TrialBalance").Connect

 

[Steven]

?CurrentDb.TableDefs("TrialBalance").Connect
MS
Access;PWD=FirstPwd;DATABASE=U:\Accounting\Ac01\CorporateAcctAc01\TaxStreamFiles.mdb

 

[Steven]

I went into Link Table Manager and clicked Always Prompt for New Location
and picked the same database it was already linked to and now it works. Was
that a coinsidence or did something occur there?

Thank you,

Steven

 

[Steven]

I spoke too soon. Now its back to the same problem.

 

[Steven]

It seems if I take the Password off the file and then go to Link Manager and
click Always prompt for a new location; then the relink code seems to work.
Is there a problem with the way I am passing the password on the setDBLink in
the first email?

 

[JimBurke via AccessMonster.com]

I see that in the fGetLinkedTables function you have the following:

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

I don't know this code well and it would take too much time to look through
everything, but from what I can see it looks like the code is appending the
Connect value to the Name value here. If it's not an ODBC connection, there's
nothing to separate the table name from the connect value. When you showed
what the Connect value was, you showed this:

MS
Access;PWD=FirstPwd;DATABASE=U:\Accounting\Ac01\CorporateAcctAc01\
TaxStreamFiles.mdb

When the table name is parsed in function fParseTable it looks for a ';' as
the delimiter. in your case, since you aren't using ODBC, there was no ';'
placed between the table name and the connect value, so it is taking the
table name concatenated with MSAccess, since there is a ';' right after
MSAccess in the connect value. That's what it looks like to me. I don't know
if you modified this code or if it's the original code you copied, and I
don't know what the intent is of not separating the table name from the
connect value if it's not ODBC, but it looks like that's what's causing your
problem from what I can tell.

 

[Steven]

Jim,

Based on your response I tried a few things without success. So then your
response made me think some more and I decided to just trim MS Access off the
strTbl if it exists. And that seems to work fine, at least so far.

I did not write the code but the only adjustment I have made is to add a
password to the line of code on the Set dbLink... and now the removing of
the MS Access if it is there. The issue seems to come up when there is a
password on the linked mdb. When it does not have a password there is no
problem.

I think this is going to work now. Thank you for your response. It helped
me get to a solution.

Steven

 

[Steven]

Dirk,

Thank you for your response. It helped me get to a solution and I learned
something new. Using the Immediate Window.

Steven

 

[david]

That is an unexpected result.

The Dev Ashish code has been in use for a very long time, and
something in Access has changed which has broken it.

Originally, the first field, which you have as "MS Access", was
empty for MS Access tables. It was only filled in for "ODBC"
"Excel" tables and other tables.

The Dev Ashish sample code only handles "MS Access" tables
(which it assumes to start with an empty field" and "ODBC"
tables. It can't handle this new kind of link field where the
table type is explicitly given as "MS Access".

Here is a modification which may work for you:

(declare s as string at top of fGetLinkedTables() )
s = .Connect
collTables.Add Item:=.Name & right(s,len(s)-instr(s,";")), Key:=.Name

(david)