Reattach tables

Question

I have a database with split front- and back-ends. Acc97. The database works great.

I've written a code-based backup routine for the back-end database. Right now, the path to the back-end is hard-coded into the routine, which means that when I install it on a new machine, I have to change the path by hand. You know the routine....

To remedy this situation, I've made a query using the MSysObjects table to return the location of my main database tables. Then, I'll take the results of this query and parse it for path.

That seems a bit obtuse for a solution. Any other ideas?

Answer

Gene,

Here is a little bit tricky one. Enjoy!

HTH,
Shamil

Public Function smsTrickyAutoRefreshLink() As Boolean
'*+
'
' Purpose     : Auto refresh links to the back-end mdb file(s)' tables which
'             : is(are) located in the ***same*** directory as front-end one.
'
' Assumptions : Back-end database(s) is/are MS Access one(s)
'             : Front-end and back-end databases are located in the same
'             : directory.
'             : Front-end database FileName is equal to its
'             : Tools->Options->Advanced->Project Name.
'             : Back-end database(s) name(s) is/are constant.
'
' Returns     : True  - Links were refreshed successfully.
'             : False - Error detected during links auto refreshment.
'
' Author      : Shamil Salakhetdinov, St.Petersburg, Russia
' e-mail      : shamil@marta.darts.spb.ru
'
' Written     : 98/04/18
'
' Tested on   : MS Access 97/WinNT 4.0
'
' Comments    : - The links are refreshed only if you move both front- and back-end
'             :   to the new directory.
'             : - If you copy/move front-end only the links aren't refreshed.
'             : - If you move front-end into one directory and back-end into another
'             :   links refreshment fails.
'             : - etc...
'
'-
    On Error GoTo smsTrickyAutoRefreshLink_Err
    
    Dim tdf As TableDef
    Dim i As Integer
    Dim strBackEndFileNameExt As String
    Dim strTst As String
    Dim strConnect As String
    
    DoCmd.Hourglass True
    SysCmd acSysCmdSetStatus, "Starting links auto refreshment..."
    ' look for linked table(s)
    For Each tdf In CodeDb().TableDefs
      SysCmd acSysCmdSetStatus, "Processing table [" & tdf.Name & "]..."
      
      If tdf.Connect <> "" Then
        On Error Resume Next
        ' check that link is actual
        strTst = DBEngine(0).OpenDatabase(Mid(tdf.Connect, 11)).Name
        If Err <> 0 Then
          ' clear error and reset last On Error handler
          On Error GoTo smsTrickyAutoRefreshLink_Err
          
          SysCmd acSysCmdSetStatus, "Refreshing link of table [" & tdf.Name & "]..."
        
          ' get the Filename.Ext of backend mdb for current link
          strBackEndFileNameExt = ""
          For i = Len(tdf.Connect) To 1 Step -1
            If Mid(tdf.Connect, i, 1) <> "\" Then
              strBackEndFileNameExt = Mid(tdf.Connect, i, 1) & strBackEndFileNameExt
            Else
              Exit For
            End If
          Next
        
          ' get new connect string
          strConnect = ";Database=" & _
                      Mid(CodeDb().Name, _
                      1, InStr(1, CodeDb().Name, _
                                  GetOption("Project Name")) - 1) & _
                      strBackEndFileNameExt
          If strConnect <> tdf.Connect Then
             ' refresh link
             tdf.Connect = strConnect
             tdf.RefreshLink
          Else
             ' Force an error message to appear in the case if back-end is moved
             ' to another directory
             strTst = DBEngine(0).OpenDatabase(Mid(tdf.Connect, 11)).Name
          End If
        Else
          On Error GoTo smsTrickyAutoRefreshLink_Err
        End If
      End If
    Next
    
    smsTrickyAutoRefreshLink = True
    
smsTrickyAutoRefreshLink_Exit:
    SysCmd acSysCmdClearStatus
    DoCmd.Hourglass False
    smsTrickyAutoRefreshLink = True
    Exit Function
    
smsTrickyAutoRefreshLink_Err:
    MsgBox "smsTrickyAutoRefreshLink: " & Err & " - " & _
           Err.Description, vbCritical + vbOKOnly, _
           "Links Auto Refresher"
    smsTrickyAutoRefreshLink = False
    Resume smsTrickyAutoRefreshLink_Exit
End Function