Preserving linked tables for Access DBs in same folder when the folder changes

I've got two Access databases that share linked tables. They are deployed together in a directory and accessed via code in a Word form.

How can I make sure that the links are preserved when the two databases are copied (together) to a different folder? Since I'm not "opening" the database, per se (it's being accessed via ADO), I don't know how to write code to refresh the links.

From stackoverflow

• It is possible to link tables via ADO. You could keep a 'table of tables' to iterate through and run some code in Word. Here is an example set up to run in VBScript, but it should work in Word:

     'Reference Microsoft ADO Ext x.x for DDL and Security'
     Dim cn 'As ADODB.Connection'
     Dim ct 'As ADOX.Catalog'
     Dim tbl 'As ADOX.Table'
  
     Dim strLinkXL 'As String'
     Dim strLinkMDB 'As String'
     Dim strMDB 'As String'
  
     strLinkXL = "C:\Docs\LTD.xls"
     strLinkMDB = "C:\Docs\db1.mdb"
     strMDB = "C:\Docs\LTD.mdb"
  
     'Create Link...'
     Set cn = CreateObject("ADODB.Connection")
     cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source=" & strMDB & ";" & _
            "Persist Security Info=False"
  
     Set ct = CreateObject("ADOX.Catalog")
     Set ct.ActiveConnection = cn
  
     Set tbl = CreateObject("ADOX.Table")
     Set tbl.ParentCatalog = ct
  
     '1. Link MDB'
  
     With tbl
       'What the link table will be called'
       .Name = "LinkTableMDB"
       'Name of the table to link'
       .properties("Jet OLEDB:Remote Table Name") = "Table1"
       .properties("Jet OLEDB:Link Datasource") = strLinkMDB
       .properties("Jet OLEDB:Link Provider String") = "MS Access"
       .properties("Jet OLEDB:Create Link") = True
     End With
  
     'Append the table to the tables collection'
     ct.Tables.Append tbl
     Set tbl = Nothing
  

  From: http://wiki.lessthandot.com/index.php/Linking_Tables_via_Jet_and_ADO

  David-W-Fenton : Why ADO? Why not native DAO?

  David-W-Fenton : Oops -- missed the context in Word. I still don't know why DAO wouldn't be more appropriate, though.

• Are you referring to updating the links within your Word form, or the linked table links between your Access databases?

  For the former, the best way that I know is to keep your connection string(s) at the Module level within your Word document/VBA project and make them const strings. Then when setting the connection string for your ADO Connection objects, pass it the relative connection string const.

  For the latter, I would be tempted to use a relative path in the connection string to data within each Access database to the other. For example,

  Dim connectionString as String
  
  connectionString = ";DATABASE=" & CurrentProject.Path & "\[Database Name Here].mdb"
  

  if as you say, the databases are copied together to a different folder (I'm assuming into the same folder).

• Update 14APR2009 I found that the previous answer I gave here was erroneous, so I updated it with new code.

  How to proceed

  • Copy the code below to a VBA module.

  • From code or from the Immediate window in the VBA IDE, simply type:

    RefreshLinksToPath Application.CurrentProject.Path
    

  This will now relink all the linked tables to use the directory where your application is located.
  It only needs to be done once or whenever you relink or add new tables.
  I recommend doing this from code every time you start your application.
  You can then move your databases around without problems.

  Code

  '------------------------------------------------------------'
  ' Reconnect all linked tables using the given path.          '
  ' This only needs to be done once after the physical backend '
  ' has been moved to another location to correctly link to    '
  ' the moved tables again.                                    '
  ' If the OnlyForTablesMatching parameter is given, then      '
  ' each table name is tested against the LIKE operator for a  '
  ' possible match to this parameter.                          '
  ' Only matching tables would be changed.                     '
  ' For instance:                                              '
  ' RefreshLinksToPath(CurrentProject.Path, "local*")          '
  ' Would force all tables whose ane starts with 'local' to be '
  ' relinked to the current application directory.             '
  '------------------------------------------------------------'
  Public Function RefreshLinksToPath(strNewPath As String, _
      Optional OnlyForTablesMatching As String = "*") As Boolean
  
      Dim collTbls As New Collection
      Dim i As Integer
      Dim strDBPath As String
      Dim strTbl As String
      Dim strMsg As String
      Dim strDBName As String
      Dim strcon As String
      Dim dbCurr As DAO.Database
      Dim dbLink As DAO.Database
      Dim tdf As TableDef
  
      Set dbCurr = CurrentDb
  
      On Local Error GoTo fRefreshLinks_Err
  
      'First get all linked tables in a collection'
      dbCurr.TableDefs.Refresh
      For Each tdf In dbCurr.TableDefs
          With tdf
              If ((.Attributes And TableDefAttributeEnum.dbAttachedTable) = TableDefAttributeEnum.dbAttachedTable) _
                 And (.Name Like OnlyForTablesMatching) Then
                  collTbls.Add Item:=.Name & .Connect, key:=.Name
              End If
          End With
      Next
      Set tdf = Nothing
  
      ' Now link all of them'
      For i = collTbls.count To 1 Step -1
          strcon = collTbls(i)
          ' Get the original name of the linked table '
          strDBPath = Right(strcon, Len(strcon) - (InStr(1, strcon, "DATABASE=") + 8))
          ' Get table name from connection string '
          strTbl = Left$(strcon, InStr(1, strcon, ";") - 1)
          ' Get the name of the linked database '
          strDBName = Right(strDBPath, Len(strDBPath) - InStrRev(strDBPath, "\"))
  
          ' Reconstruct the full database path with the given path '
          strDBPath = strNewPath & "\" & strDBName
  
          ' Reconnect '
          Set tdf = dbCurr.TableDefs(strTbl)
          With tdf
              .Connect = ";Database=" & strDBPath
              .RefreshLink
              collTbls.Remove (.Name)
          End With
      Next
      RefreshLinksToPath = True
  
  fRefreshLinks_End:
      Set collTbls = Nothing
      Set tdf = Nothing
      Set dbLink = Nothing
      Set dbCurr = Nothing
      Exit Function
  
  fRefreshLinks_Err:
      RefreshLinksToPath = False
      Select Case Err
          Case 3059:
  
          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
              Resume fRefreshLinks_End
      End Select
  End Function
  

  This code is adapted from this source: http://www.mvps.org/access/tables/tbl0009.htm.
  I removed all dependency on other functions to make it self-contained, that's why it's a bit longer than it should.

• Renaud's code is probably the slickest computer thing I have ever seen. Thankyou