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

Dev Ashish's fRefreshLinks with password error

P: 45
Hi all,

I'm calling a slightly modified Dev Ashish's fRefreshLinks as part of handling an error on opening the switchboard if the backend linked tables are missing. It's Access 2007.

I found a two line tweak online to enable the function to handle passwords, however, after implementing this I'm running into a strange error where the variable strTbl is having "MS Access" appended to it. The exact error message I am getting is:

"Table 'tblTitlesMS Access' was not found in the database C:\Correct\Path\And\DB\Name.accdb. Couldn't refresh links" Note: strTbl = "tblTitlesMS Access")

The correct table name would be 'tblTitles'. There is no instance of "MS Access" in the code, so this must be coming from somewhere else. I suspect this code would be working if it wasn't for this mysterious excess Access

Following is the exact code I currently have. Hopefully somebody here is already familiar with it, I wouldn't expect anybody to digest it from scratch. I have emboldened my own tweaks as well as instances of strTbl - the offending variable - and the error handler being invoked.

I pretty much understand how the code works and follow the logic, but I don't know enough about the underlying processes in linking tables to pinpoint the cause of this.

Any ideas would be much appreciated.

Thanks,

Jay

Expand|Select|Wrap|Line Numbers
  1. '*************** Code Start ***************
  2. ' This code was originally written by Dev Ashish.
  3. ' It is not to be altered or distributed,
  4. ' except as part of an application.
  5. ' You are free to use it in any application,
  6. ' provided the copyright notice is left unchanged.
  7. '
  8. ' Code Courtesy of
  9. ' Dev Ashish
  10. '
  11. Function fRefreshLinks(strPrompt As String) As Boolean
  12. Dim strMsg As String, collTbls As Collection
  13. Dim i As Integer, strDBPath As String, strTbl As String
  14. Dim dbCurr As Database, dbLink As Database
  15. Dim tdfLocal As TableDef
  16. Dim varRet As Variant
  17. Dim strNewPath As String
  18. Dim cPassword As String
  19.  
  20. Const cERR_USERCANCEL = vbObjectError + 1000
  21. Const cERR_NOREMOTETABLE = vbObjectError + 2000
  22.  
  23.     On Local Error GoTo fRefreshLinks_Err
  24.  
  25.     'Prompt User
  26.     If MsgBox(strPrompt, vbQuestion + vbYesNo, "Alternate data source...") = vbYes Then
  27.         strNewPath = fGetMDBName("Please select a new datasource")
  28.     Else
  29.     Err.Raise cERR_USERCANCEL
  30.     End If
  31.  
  32.     'Get Password
  33.     cPassword = InputBox("Please enter your backend password:", "Enter Password.")
  34.  
  35.    'First get all linked tables in a collection
  36.     Set collTbls = fGetLinkedTables
  37.  
  38.     'now link all of them
  39.     Set dbCurr = CurrentDb
  40.  
  41.     For i = collTbls.Count To 1 Step -1
  42.         strDBPath = fParsePath(collTbls(i))
  43.         strTbl = fParseTable(collTbls(i))
  44.         varRet = SysCmd(acSysCmdSetStatus, "Now linking '" & strTbl & "'....")
  45.         If Left$(strDBPath, 4) = "ODBC" Then
  46.             'ODBC Tables
  47.             'ODBC Tables handled separately
  48.            ' Set tdfLocal = dbCurr.TableDefs(strTbl)
  49.            ' With tdfLocal
  50.            '     .Connect = pcCONNECT
  51.            '     .RefreshLink
  52.            '     collTbls.Remove (strTbl)
  53.            ' End With
  54.         Else
  55.             If strNewPath <> vbNullString Then
  56.                 'Try this first
  57.                 strDBPath = strNewPath
  58.             Else
  59.                 If Len(Dir(strDBPath)) = 0 Then
  60.                     'File Doesn't Exist, call GetOpenFileName
  61.                     strDBPath = fGetMDBName("'" & strDBPath & "' not found.")
  62.                     If strDBPath = vbNullString Then
  63.                         'user pressed cancel
  64.                         Err.Raise cERR_USERCANCEL
  65.                     End If
  66.                 End If
  67.             End If
  68.  
  69.             'backend database exists
  70.             'putting it here since we could have
  71.             'tables from multiple sources
  72.             'Set dbLink = DBEngine(0).OpenDatabase(strDBPath) ' Original
  73.             Set dbLink = DBEngine(0).OpenDatabase(strDBPath, False, True, ";pwd =" & cPassword) ' With Password
  74. '
  75.             'check to see if the table is present in dbLink
  76.             strTbl = fParseTable(collTbls(i))
  77.             If fIsRemoteTable(dbLink, strTbl) Then
  78.                 'everything's ok, reconnect
  79.                 Set tdfLocal = dbCurr.TableDefs(strTbl)
  80.                 With tdfLocal
  81.                     '.Connect = ";Database=" & strDBPath ' Original
  82.                     .Connect = ";Database=" & strDBPath & ";PWD=" & cPassword ' With Password
  83.                     .RefreshLink
  84.                     collTbls.Remove (.Name)
  85.                 End With
  86.             Else
  87.                 Err.Raise cERR_NOREMOTETABLE
  88.             End If
  89.         End If
  90.     Next
  91.     fRefreshLinks = True
  92.     varRet = SysCmd(acSysCmdClearStatus)
  93.     MsgBox "All Access tables were successfully reconnected.", _
  94.             vbInformation + vbOKOnly, _
  95.             "Success"
  96.  
  97. fRefreshLinks_End:
  98.     Set collTbls = Nothing
  99.     Set tdfLocal = Nothing
  100.     Set dbLink = Nothing
  101.     Set dbCurr = Nothing
  102.     Exit Function
  103. fRefreshLinks_Err:
  104.     fRefreshLinks = False
  105.     Select Case Err
  106.         Case 3059:
  107.  
  108.         Case cERR_USERCANCEL:
  109.             MsgBox "No Database was specified, couldn't link tables.", _
  110.                     vbCritical + vbOKOnly, _
  111.                     "Error in refreshing links."
  112.             Resume fRefreshLinks_End
  113.         Case cERR_NOREMOTETABLE:
  114.             MsgBox "Table '" & strTbl & "' was not found in the database" & _
  115.                     vbCrLf & dbLink.Name & ". Couldn't refresh links", _
  116.                     vbCritical + vbOKOnly, _
  117.                     "Error in refreshing links."
  118.             Resume fRefreshLinks_End
  119.         Case Else:
  120.             strMsg = "Error Information..." & vbCrLf & vbCrLf
  121.             strMsg = strMsg & "Function: fRefreshLinks" & vbCrLf
  122.             strMsg = strMsg & "Description: " & Err.Description & vbCrLf
  123.             strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
  124.             MsgBox strMsg, vbOKOnly + vbCritical, "Error"
  125.             Resume fRefreshLinks_End
  126.     End Select
  127. End Function
  128.  
  129. Function fIsRemoteTable(dbRemote As Database, strTbl As String) As Boolean
  130. Dim tdf As TableDef
  131.     On Error Resume Next
  132.     Set tdf = dbRemote.TableDefs(strTbl)
  133.     fIsRemoteTable = (Err = 0)
  134.     Set tdf = Nothing
  135. End Function
  136.  
  137. Function fGetMDBName(strIn As String) As String
  138. 'Calls GetOpenFileName dialog
  139. Dim strFilter As String
  140.  
  141.     strFilter = ahtAddFilterItem(strFilter, _
  142.                     "Access Database(*.mdb;*.mda;*.mde;*.mdw) ", _
  143.                     "*.mdb; *.mda; *.mde; *.mdw")
  144.     strFilter = ahtAddFilterItem(strFilter, _
  145.                     "All Files (*.*)", _
  146.                     "*.*")
  147.  
  148.     fGetMDBName = ahtCommonFileOpenSave(Filter:=strFilter, _
  149.                                 OpenFile:=True, _
  150.                                 DialogTitle:=strIn, _
  151.                                 Flags:=ahtOFN_HIDEREADONLY)
  152. End Function
  153.  
  154. Function fGetLinkedTables() As Collection
  155. 'Returns all linked tables
  156.     Dim collTables As New Collection
  157.     Dim tdf As TableDef, db As Database
  158.     Set db = CurrentDb
  159.     db.TableDefs.Refresh
  160.     For Each tdf In db.TableDefs
  161.         With tdf
  162.             If Len(.Connect) > 0 Then
  163.                 If Left$(.Connect, 4) = "ODBC" Then
  164.                 '    collTables.Add Item:=.Name & ";" & .Connect, KEY:=.Name
  165.                 'ODBC Reconnect handled separately
  166.                 Else
  167.                     collTables.Add Item:=.Name & .Connect, Key:=.Name
  168.                 End If
  169.             End If
  170.         End With
  171.     Next
  172.     Set fGetLinkedTables = collTables
  173.     Set collTables = Nothing
  174.     Set tdf = Nothing
  175.     Set db = Nothing
  176. End Function
  177.  
  178. Function fParsePath(strIn As String) As String
  179.     If Left$(strIn, 4) <> "ODBC" Then
  180.         fParsePath = Right(strIn, Len(strIn) _
  181.                         - (InStr(1, strIn, "DATABASE=") + 8))
  182.     Else
  183.         fParsePath = strIn
  184.     End If
  185. End Function
  186.  
  187. Function fParseTable(strIn As String) As String
  188.     fParseTable = Left$(strIn, InStr(1, strIn, ";") - 1)
  189. End Function
Apr 10 '12 #1
Share this Question
Share on Google+
7 Replies


NeoPa
Expert Mod 15k+
P: 31,494
Jay, you need to include some basic information here such as the line the error message occurs on. Otherwise this is a needle in a haystack situation. Please check out Before Posting (VBA or SQL) Code for some more instructns on what needs to be done prior to posting a question about included code.
Apr 11 '12 #2

100+
P: 759
Your code looks good for me.
In your current database seems to exist (indeed) a table named tblTitlesMS Access.
I suspect that it is hidden (Don't ask me why :) ).
So, in order to debug, do the following:

Navigate to:
Office Button -> Access Options -> Current Database -> Navigation Options
and check all check boxes in Display Options area.
After that, in Navigation Pane, look for that table and remove it (if you find it).


Make a copy before !


@NeoPa
The code will not stop at this error.
Line #87 will raise the error and the error message is from line #114
Apr 11 '12 #3

P: 45
Hi Mihail,

An existing table was my first thought, however even on enabling all options, no table by the name of "tblTitlesMS Access" exists. Is there some other way a tabledef could be hidden?

As you predicted, even on commenting out the "On Local Error..." line, the code doesn't throw an error until it reaches line 87. (I had previously tested this, but missed it from my post, apologies Neo).

On placing a debug dot in the Function fParseTable and bringing up strIn in a MsgBox displays:

tblTitlesMS Access;PWD=asdfzxcv;DATABASE=C:\Correct\Path\And\N ame.accdb

This would indeed point to a TableDef by that name existing. However, I have just placed the code...

Expand|Select|Wrap|Line Numbers
  1. Dim x as Integer
  2. x = 1
  3. For i = collTbls.Count To 1 Step -1
  4.         If Left(collTbls(i), 9) = "tblTitles" Then
  5.             i = i - x
  6.         End If
  7.  
...at the start of the For loop. I then tried assigning various numbers to x and the error is now the same, but with which ever table falls at that number, e.g. "tblStatusMS Access", "tblContactMS Access".

This would point to either a duplication of all tables with MS Access appended to them, or seemingly more likely, that strTbl is having MS Access appended to it before being passed to fParseTable.


Any thoughts?

Thanks again,

Jamie
Apr 11 '12 #4

100+
P: 759
Is beyond my skill (or my working time) to fully debug your code.
Here is how I manage the "link" issue for a Front End database:
Expand|Select|Wrap|Line Numbers
  1. Public Function ReConnect(BackEndPath As String) As Boolean
  2.     ReConnect = False
  3. On Error GoTo ErrorHandler
  4. If BackEndPath = "" Then Exit Function
  5.  
  6. Dim tbl As TableDef
  7. Dim db As Database
  8. '(Re)link current Front End database
  9.     Set db = CurrentDb
  10.     GoSub RelinkThisFE
  11.  
  12.     'All is Ok
  13.     ReConnect = True
  14.  
  15. Ex:
  16. Exit Function
  17.  
  18. RelinkThisFE:
  19.     With db
  20.         For Each tbl In .TableDefs
  21.             If (tbl.Attributes And dbAttachedTable) Then 'This is a linked table
  22.                 With .TableDefs(tbl.Name)
  23.                     .Connect = ";DATABASE=" & BackEndPath
  24.                     Call .RefreshLink
  25.                 End With
  26.             End If
  27.         Next
  28.         Call .Close
  29.     End With
  30. Return
  31.  
  32. ErrorHandler:
  33.     MsgBox ("I think that you have wrong selected the back end database. Try again !")
  34.     db.Close
  35.     set db  = Nothing
  36.     Resume Ex
  37. End Function
Apr 11 '12 #5

NeoPa
Expert Mod 15k+
P: 31,494
I would trace through fGetLinkedTables(). I suspect it is creating your collection incorrectly, as it is based on the assumption that any .Connect string that doesn't start with "ODBC" must necessarily start with a ";". There is an .Attributes property that is a better test for that in my view (Check out the difference between dbAttachedTable and dbAttachedODBC).
Apr 11 '12 #6

P: 45
Sure Mihail, I understand that. I was hoping it was something that would jump out and smack you in the face. Thanks for your solution. I'll have a play with it if I can't fix this one.

You inadvertently gave me a new lead. In unhiding the System objects you showed me the table MSysObjects which includes a Connect field showing "MS Access;PWD=asdfzxcv;". I'm going to play with the code with this in mind.


NeoPa, fGetLinkedTables contains the line:

collTables.Add Item:=.Name & .Connect, Key:=.Name

The part in bold would account for the strange concatenation. I just need to tweak it to create a valid connection string, which I should be able to figure out.

Thanks again guys.
Apr 11 '12 #7

NeoPa
Expert Mod 15k+
P: 31,494
In most cases that will work reliably Jay. The thing to do is to discover the exception (Tracing should help).

I suspect that code amended to use the .Attributes property, instead of the contents of the .Connect property, will handle the situation more reliably.
Apr 11 '12 #8

Post your reply

Sign in to post your reply or Sign up for a free account.