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

Linked tables in MS Access 2003

P: 14
I am building a media management tool and starting it in Access 2003.
I have various linked tables, and have sufficient code to loop through my list of linked tables to verify that the data file specified in the link is available in the specified path.

I am trying to finish this portion of my code to handle the table(s) whose links are broken because the specified file no longer exists.

Can someone suggest how I might "re-link" a table or several table (within the same data source) through VBA? Right now the links are to other MDB data sources.

What I am trying to avoid is running the re-link routine that I have every time the program starts even when there is nothing to do, and also I do not want to re-link tables whose links are perfectly good. Doing this, wastes a lot of startup time. I have about 11 tables now, but with the prospect if that list growing, I am trying to build my program to have a more intelligient way to check each link before "re-creating" it without having to redo all of them every time.

Thanks,
CJ
Dec 30 '08 #1
Share this Question
Share on Google+
7 Replies


Delerna
Expert 100+
P: 1,134
Hard to see exactly what you are doing from the description, but one thought is to arrange things so that the relinking routine runs
only when you capture an error that occurs within some VBA code because of a broken link. Hope my meaning in that statement is clear?

Need more detail to give you an idea on how to go about doing that.
Dec 30 '08 #2

P: 14
OK, here is the code I have so far, this lists the tables that are linked into a collection each is referenced by an index, and the code which will extract the table name, and its current link from that indexed entry.
Then what I do is run a check to see if the referenced file exists.
This is where I start to run into trouble. If the file exists, then I would simply keep going through the collection until I came to a table which had a link to a different back-end database. Then I would test to see if that file existed and so on. If each of the different back-end files exist, then no re-linking should occur. This should allow, my program to start relatively quickly. If one or more of the back-end tables did not exist based on what the current link says it should be, then that table should be re-linked, test the next entry and so on.

Here is my code (kind of a collection of different things), there may be stuff in here, I really do not need once this is done.
Expand|Select|Wrap|Line Numbers
  1. Function DataSourceTest()
  2. 'This function is a test function built to test the back-end data connectivity code
  3. 'This will be the code that will list the tables, see where they are connected and whether or not the data source is actually available
  4.  
  5. Dim x
  6. Dim TableDataPath As String
  7. Dim PathToData As String
  8. Dim NewFile As String
  9.  
  10. 'Get list of linked tables, and their data source
  11. fGetLinkedTables
  12.  
  13. 'Loop through each item in the collection of linked tables to decide what to do with it
  14. For x = 1 To LinkedTables.Count
  15.     Debug.Print LinkedTables.Item(x)
  16.  
  17.     TableDataPath = Left$(LinkedTables.Item(x), InStrRev(LinkedTables.Item(x), ";"))
  18.     TableDataPath = Left$(TableDataPath, Len(TableDataPath) - 1)
  19.     Debug.Print TableDataPath
  20.  
  21.     PathToData = GetDataPath(TableDataPath)
  22.     Debug.Print PathToData
  23.  
  24.     If FileOrDirExists(PathToData) = True Then
  25.         'Available, do nothing
  26.     Else
  27.         'Not available, locate the data file
  28.         MsgBox "The back-end data source for: " & TableDataPath & " is not available." & vbCrLf & "Please locate the data source."
  29.         NewFile = fGetMDBName(TableDataPath)
  30.     End If
  31. Next
  32.  
  33. End Function
  34.  
  35. Function fGetLinkedTables()
  36. 'Returns all linked tables
  37.     Dim collTables As New Collection
  38.     Dim tdf As TableDef, db As Database
  39.     Set db = CurrentDb
  40.     db.TableDefs.Refresh
  41.     For Each tdf In db.TableDefs
  42.         With tdf
  43.             If Len(.Connect) > 0 Then
  44.                 If Left$(.Connect, 4) = "ODBC" Then
  45.                 '    collTables.Add Item:=.Name & ";" & .Connect, KEY:=.Name
  46.                 'ODBC Reconnect handled separately
  47.                 Else
  48.                     collTables.Add Item:=.Name & .Connect, Key:=.Name
  49.                 End If
  50.             End If
  51.         End With
  52.     Next
  53.     Set fGetLinkedTables = collTables
  54.     Set LinkedTables = collTables
  55.     Set collTables = Nothing
  56.     Set tdf = Nothing
  57.     Set db = Nothing
  58. End Function
  59.  
  60. Public Function GetDataPath(strTable As String) As String
  61. 'On Error GoTo Err_Handler
  62.  
  63. 'Purpose:   Return the full path of the file from the Connect property of this tabledef.
  64. 'Return:    Full path and file name for attached MDB.
  65. '           Just the path for some other types (e.g. attached text.)
  66. '           Zero-length string for local table (not attached), or of argument is zero-length.
  67. '           "#Error" on error, e.g. table not found.
  68. 'Requires:  Split() function for Access 97 or earlier.
  69.  
  70. Dim varArray As Variant
  71. Dim i As Integer
  72.  
  73. If Trim$(strTable) <> vbNullString Then
  74.     varArray = Split(CurrentDb.TableDefs(strTable).Connect, ";")
  75.     For i = LBound(varArray) To UBound(varArray)
  76.         If varArray(i) Like "DATABASE=*" Then
  77.             GetDataPath = Trim$(Mid$(varArray(i), 10))
  78.             Exit For
  79.         End If
  80.     Next
  81. End If
  82.  
  83. Exit_Handler:
  84.  
  85.     Exit Function
  86.  
  87. Err_Handler:
  88.  
  89.     'Call LogError(Err.Number, Err.Description, conMod & ".GetDataPath", strTable, False)
  90.     'GetDataPath = "#Error"
  91.     Resume Exit_Handler
  92.  
  93. End Function
  94.  
  95. 'This function will make sure the file specified in the linked property is available
  96. 'If available, then nothing should happen, if not, then a request to locate to data files will be presented to the user
  97.  
  98. Function FileOrDirExists(PathName As String) As Boolean
  99.  
  100.      'Macro Purpose: Function returns TRUE if the specified file
  101.      '               or folder exists, false if not.
  102.      'PathName     : Supports Windows mapped drives or UNC
  103.      '             : Supports Macintosh paths
  104.      'File usage   : Provide full file path and extension
  105.      'Folder usage : Provide full folder path
  106.      '               Accepts with/without trailing "\" (Windows)
  107.      '               Accepts with/without trailing ":" (Macintosh)
  108.  
  109.     Dim iTemp As Integer
  110.  
  111.      'Ignore errors to allow for error evaluation
  112.     On Error Resume Next
  113.     iTemp = GetAttr(PathName)
  114.  
  115.      'Check if error exists and set response appropriately
  116.     Select Case Err.Number
  117.     Case Is = 0
  118.         FileOrDirExists = True
  119.     Case Else
  120.         FileOrDirExists = False
  121.     End Select
  122.  
  123.      'Resume error checking
  124.     On Error GoTo 0
  125.  
  126. End Function
  127.  
  128. Function fRefreshLinks() As Boolean
  129.  
  130. Dim strMsg As String, collTbls As Collection
  131. Dim i As Integer, strDBPath As String, strTbl As String
  132. Dim dbCurr As Database, dbLink As Database
  133. Dim tdfLocal As TableDef
  134. Dim varRet As Variant
  135. Dim strNewPath As String
  136.  
  137. Const cERR_USERCANCEL = vbObjectError + 1000
  138. Const cERR_NOREMOTETABLE = vbObjectError + 2000
  139.  
  140.     'On Local Error GoTo fRefreshLinks_Err
  141.  
  142.     'If MsgBox("Are you sure you want to reconnect all Access tables?", _
  143.             vbQuestion + vbYesNo, "Please confirm...") = vbNo Then Err.Raise cERR_USERCANCEL
  144.  
  145.     'First get all linked tables in a collection
  146.     Set collTbls = fGetLinkedTables
  147.  
  148.     'now link all of them
  149.     Set dbCurr = CurrentDb
  150.  
  151.     strMsg = "Do you wish to specify a different path for the Access Tables?"
  152.  
  153.     If MsgBox(strMsg, vbQuestion + vbYesNo, "Alternate data source...") = vbYes Then
  154.         strNewPath = fGetMDBName("Please select a new datasource")
  155.     Else
  156.         strNewPath = vbNullString
  157.     End If
  158.  
  159.     For i = collTbls.Count To 1 Step -1
  160.         strDBPath = fParsePath(collTbls(i))
  161.         strTbl = fParseTable(collTbls(i))
  162.         varRet = SysCmd(acSysCmdSetStatus, "Now linking '" & strTbl & "'....")
  163.         If Left$(strDBPath, 4) = "ODBC" Then
  164.             'ODBC Tables
  165.             'ODBC Tables handled separately
  166.            ' Set tdfLocal = dbCurr.TableDefs(strTbl)
  167.            ' With tdfLocal
  168.            '     .Connect = pcCONNECT
  169.            '     .RefreshLink
  170.            '     collTbls.Remove (strTbl)
  171.            ' End With
  172.         Else
  173.             If strNewPath <> vbNullString Then
  174.                 'Try this first
  175.                 strDBPath = strNewPath
  176.             Else
  177.                 If Len(Dir(strDBPath)) = 0 Then
  178.                     'File Doesn't Exist, call GetOpenFileName
  179.                     strDBPath = fGetMDBName("'" & strDBPath & "' not found.")
  180.                     If strDBPath = vbNullString Then
  181.                         'user pressed cancel
  182.                         Err.Raise cERR_USERCANCEL
  183.                     End If
  184.                 End If
  185.             End If
  186.  
  187.             'backend database exists
  188.             'putting it here since we could have
  189.             'tables from multiple sources
  190.             Set dbLink = DBEngine(0).OpenDatabase(strDBPath)
  191.  
  192.             'check to see if the table is present in dbLink
  193.             strTbl = fParseTable(collTbls(i))
  194.             If fIsRemoteTable(dbLink, strTbl) Then
  195.                 'everything's ok, reconnect
  196.                 Set tdfLocal = dbCurr.TableDefs(strTbl)
  197.                 With tdfLocal
  198.                     .Connect = ";Database=" & strDBPath
  199.                     .RefreshLink
  200.                     collTbls.Remove (.Name)
  201.                 End With
  202.             Else
  203.                 Err.Raise cERR_NOREMOTETABLE
  204.             End If
  205.         End If
  206.     Next
  207.     fRefreshLinks = True
  208.     varRet = SysCmd(acSysCmdClearStatus)
  209.     MsgBox "All Access tables were successfully reconnected.", _
  210.             vbInformation + vbOKOnly, _
  211.             "Success"
  212.  
  213. fRefreshLinks_End:
  214.     Set collTbls = Nothing
  215.     Set tdfLocal = Nothing
  216.     Set dbLink = Nothing
  217.     Set dbCurr = Nothing
  218.     Exit Function
  219. fRefreshLinks_Err:
  220.     fRefreshLinks = False
  221.     Select Case Err
  222.         Case 3059:
  223.  
  224.         Case cERR_USERCANCEL:
  225.             MsgBox "No Database was specified, couldn't link tables.", _
  226.                     vbCritical + vbOKOnly, _
  227.                     "Error in refreshing links."
  228.             Resume fRefreshLinks_End
  229.         Case cERR_NOREMOTETABLE:
  230.             MsgBox "Table '" & strTbl & "' was not found in the database" & _
  231.                     vbCrLf & dbLink.Name & ". Couldn't refresh links", _
  232.                     vbCritical + vbOKOnly, _
  233.                     "Error in refreshing links."
  234.             Resume fRefreshLinks_End
  235.         Case Else:
  236.             strMsg = "Error Information..." & vbCrLf & vbCrLf
  237.             strMsg = strMsg & "Function: fRefreshLinks" & vbCrLf
  238.             strMsg = strMsg & "Description: " & Err.Description & vbCrLf
  239.             strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
  240.             MsgBox strMsg, vbOKOnly + vbCritical, "Error"
  241.             Resume fRefreshLinks_End
  242.     End Select
  243. End Function
  244.  
  245. Function fIsRemoteTable(dbRemote As Database, strTbl As String) As Boolean
  246. Dim tdf As TableDef
  247.     On Error Resume Next
  248.     Set tdf = dbRemote.TableDefs(strTbl)
  249.     fIsRemoteTable = (Err = 0)
  250.     Set tdf = Nothing
  251. End Function
  252.  
  253. Function fGetMDBName(strIn As String) As String
  254. 'Calls GetOpenFileName dialog
  255. Dim strFilter As String
  256.  
  257.     strFilter = ahtAddFilterItem(strFilter, _
  258.                     "Access Database(*.mdb;*.mda;*.mde;*.mdw) ", _
  259.                     "*.mdb; *.mda; *.mde; *.mdw")
  260.     strFilter = ahtAddFilterItem(strFilter, _
  261.                     "All Files (*.*)", _
  262.                     "*.*")
  263.  
  264.     fGetMDBName = ahtCommonFileOpenSave(Filter:=strFilter, _
  265.                                 OpenFile:=True, _
  266.                                 DialogTitle:=strIn, _
  267.                                 Flags:=ahtOFN_HIDEREADONLY)
  268. End Function
  269.  
  270. Function fParsePath(strIn As String) As String
  271.     If Left$(strIn, 4) <> "ODBC" Then
  272.         fParsePath = Right(strIn, Len(strIn) _
  273.                         - (InStr(1, strIn, "DATABASE=") + 8))
  274.     Else
  275.         fParsePath = strIn
  276.     End If
  277. End Function
  278.  
  279. Function fParseTable(strIn As String) As String
  280.     fParseTable = Left$(strIn, InStr(1, strIn, ";") - 1)
  281. End Function
Also, I do realize that the fRelinkTables function does actually to what my datsource test function is doing in part, but I am trying to get this down to just what I need.

Appreciate your help,and looking forward to your input.

Thanks,
CJ
Dec 31 '08 #3

P: 14
Also, this may not be quite as clean as it should or will be in the end, but the core functionality is what I am trying to do.

I suspect from your answer, you may have a better idea of how to handle this.
Dec 31 '08 #4

NeoPa
Expert Mod 15k+
P: 31,494
I'm working on something similar myself today, so I'll post something when I've worked it out if you like.
Aug 20 '09 #5

NeoPa
Expert Mod 15k+
P: 31,494
I found what I needed in other threads here, but I'll just link a couple of threads that got me going (Checking linked tables on startup & linked table).

The fundamental concept of relinking is to change the TableDef's .Connect string to reflect your new requirement, then call .RefreshLink for the TableDef.

The following code is a little routine I'm now using that returns the current address of the linked tables (Assumes all AccessLinked tables refer to the same database), and will optionally set them too, if a parameter is passed.
Expand|Select|Wrap|Line Numbers
  1. 'LinkTo() Returns the name of the database that AccessLinked tables link to.
  2. 'Assumes all AccessLinked tables refer to the same database.
  3. 'Also allows caller to specify a location to change the links to (if necessary).
  4. Public Function LinkTo(Optional ByVal strLinkDest As String = "") As String
  5.     Dim db As DAO.Database
  6.     Dim tdf As DAO.TableDef
  7.     Dim intDB As Integer
  8.     Dim strLink As String
  9.     Dim varLinkAry As Variant
  10.  
  11.     Set db = CurrentDb
  12.     For Each tdf In db.TableDefs
  13.         With tdf
  14.             If .Attributes And dbAttachedTable Then
  15.                 varLinkAry = Split(.Connect, ";")
  16.                 For intDB = LBound(varLinkAry) To UBound(varLinkAry)
  17.                     If Left(varLinkAry(intDB), 9) = "DATABASE=" Then Exit For
  18.                 Next intDB
  19.                 strLink = Mid(varLinkAry(intDB), 10)
  20.                 If LinkTo = "" Then LinkTo = strLink
  21.                 If strLinkDest = "" Or strLinkDest = strLink Then Exit For
  22.                 varLinkAry(intDB) = "DATABASE=" & strLinkDest
  23.                 .Connect = Join(varLinkAry, ";")
  24.                 Call .RefreshLink
  25.             End If
  26.         End With
  27.     Next tdf
  28. End Function
Aug 20 '09 #6

NeoPa
Expert Mod 15k+
P: 31,494
As I found I needed to add some error handling code into this, for all but very well defined environments (IE All calls checked thoroughly beforehand for invalid links), I include the updated version. The extra length is due to the error handling code.
Expand|Select|Wrap|Line Numbers
  1. 'LinkTo() Returns the name of the database that AccessLinked tables link to.
  2. 'Assumes all AccessLinked tables refer to the same database.
  3. 'Also allows caller to specify a location to change the links to (if necessary).
  4. Public Function LinkTo(Optional ByVal strLinkDest As String = "") As String
  5.     Dim db As DAO.Database
  6.     Dim tdf As DAO.TableDef
  7.     Dim intParam As Integer
  8.     Dim strLink As String
  9.     Dim varLinkAry As Variant
  10.  
  11.     Set db = CurrentDb
  12.     For Each tdf In db.TableDefs
  13.         With tdf
  14.             If .Attributes And dbAttachedTable Then
  15.                 varLinkAry = Split(.Connect, ";")
  16.                 For intParam = LBound(varLinkAry) To UBound(varLinkAry)
  17.                     If Left(varLinkAry(intParam), 9) = "DATABASE=" Then Exit For
  18.                 Next intParam
  19.                 strLink = Mid(varLinkAry(intParam), 10)
  20.                 If LinkTo = "" Then LinkTo = strLink
  21.                 If strLinkDest = "" Or strLinkDest = strLink Then Exit For
  22.                 varLinkAry(intParam) = "DATABASE=" & strLinkDest
  23.                 .Connect = Join(varLinkAry, ";")
  24.                 On Error Resume Next
  25.                 Call .RefreshLink
  26.                 Select Case Err.Number
  27.                 Case 3011, 3024, 3044, 3055, 7874
  28.                     varLinkAry(intParam) = "DATABASE=" & strLink
  29.                     .Connect = Join(varLinkAry, ";")
  30.                     strLinkDest = "Database file (" & _
  31.                                   strLinkDest & _
  32.                                   ") not found"
  33.                     Call MsgBox(strLinkDest, _
  34.                                 vbOKOnly Or vbExclamation, _
  35.                                 "LinkTo")
  36.                     Exit For
  37.                 End Select
  38.             End If
  39.         End With
  40.     Next tdf
  41. End Function
Aug 20 '09 #7

NeoPa
Expert Mod 15k+
P: 31,494
By the way, while researching this I came across a very useful function AccessError(), which takes an error number and returns the associated text. It helped me select a buch of error codes that may cause this to fail due to files/objects not being where they should be. If anyone sees any others just flag them up & I'll update.
Aug 20 '09 #8

Post your reply

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