Linked Tables Losing links

[puforee]

I have several Data Bases that use linked tables...split DB. Since a lot of these are on servers there are times when they have to be moved.
My normal set-up is to have the Frontend DB stored in a folder...let's call it DB name Folder. Also inside DB name folder I have another folder called DB. DB is where the Backend DB is stored. The Front end is stored in the DB name folder.

Anytime the Folder "DB name" is moved the links have to be reestablished. This is pains taking with a large number of links. Sometime the Select All on Update Links still does it 1 table at a time.

Question (finally)..is there a way to link the two DB's with a relative link. So DB Front end goes up one level directly to DB folder and finds the DB Backend?

I hope this is clear.

Thanks,

 

[MajP]

Here is a lot of code. It is overly complicated, but I have been using it for a long time and never got around to rewriting it. If I am using linked tables, all my databases open with a hidden form. This verifies all the links. If there is broken links then it tries to reconnect and relink. If it cannot find the tables it prompts for a new path using a file dialog. This code also allows me to switch backends at any time. In this example the user could connect to a shared backend on the network or a local replica.
Stick this code into a module.

Option Compare Database
Option Explicit

Dim UnProcessed As New Collection
Public strPath As String

Public Sub AppendTables()
  On Error GoTo errLbl:
    Dim db As DAO.Database, x As Variant
    Dim strTest As String
    ' Add names of all table with invalid links to the Unprocessed Collection.
    Set db = CurrentDb
    ClearAll
    For Each x In db.TableDefs
        If Len(x.Connect) > 1 And Len(Dir(Mid(x.Connect, 11))) = 0 Then
        ' connect string exists, but file does not
             UnProcessed.Add Item:=x.Name, Key:=x.Name
        End If
    Next
    Exit Sub
errLbl:
   If Err.Number = 52 Then
   MsgBox "Network not present."
   For Each x In db.TableDefs
        
        If Len(x.Connect) > 1 Then
        'MsgBox x.Name & " " & x.Connect
        ' connect string exists, but file does not
         UnProcessed.Add Item:=x.Name, Key:=x.Name
        End If
    Next
   Else
     Call ErrHandler(Err.Number, Err.Description, "Error in Appendtables")
   End If
End Sub

Public Function ProcessTables()

    Dim strTest As String
    On Error GoTo Err_BeginLink
    
    ' Call procedure to add all tables with broken links into a collection.
    AppendTables
    
    ' Test for existence of file name\directory selected in Common Dialog Control.
    strTest = strPath
    
    On Error GoTo Err_BeginLink
    If Len(strTest) = 0 Then   ' File not found.
        MsgBox "File not found. Please try again.", vbExclamation, "Link to new data file"
        Exit Function
    End If
    
    ' Begin relinking tables.
    Relinktables (strTest)
    ' Check to see if all tables have been relinked.
    CheckifComplete
    
    DoCmd.Echo True, "Done"
    If UnProcessed.Count < 1 Then
         MsgBox "Linking to new back-end data file was successful."
    Else
         MsgBox "Not All back-end tables were successfully relinked."
    End If
    
    
Exit_BeginLink:
    DoCmd.Echo True
    Exit Function
    
Err_BeginLink:
    Debug.Print Err.Number
    If Err.Number = 457 Then
        ClearAll
        Resume Next
    ElseIf Err.Number = 3043 Then
      MsgBox "Can not find the Master on the Network.  Check that you have a good network connection."
      Resume Exit_BeginLink
    Else
      Call ErrHandler(Err.Number, Err.Description, "Error in Processtables")
      Resume Exit_BeginLink
    End If
End Function

Public Sub ClearAll()
    Dim x
    ' Clear any and all names from the Unprocessed Collection.
    For Each x In UnProcessed
       UnProcessed.Remove (x)
    Next
End Sub

Public Function Relinktables(strFileName As String)

    Dim dbbackend As DAO.Database, dblocal As DAO.Database, ws As Workspace, x, y
    Dim tdlocal As DAO.TableDef
    
    On Error GoTo Err_Relink
    
    Set dbbackend = DBEngine(0).OpenDatabase(strFileName)
    Set dblocal = CurrentDb
    
    ' If the local linked table name is found in the back-end database
    ' we're looking at, Recreate & Refresh its connect string, and then
    ' remove its name from the Unprocessed collection.
     For Each x In UnProcessed
        If Len(dblocal.TableDefs(x).Connect) > 0 Then
            For Each y In dbbackend.TableDefs
                If y.Name = x Then
                    Set tdlocal = dblocal.TableDefs(x)
                    tdlocal.Connect = ";DATABASE=" & strPath
                    tdlocal.RefreshLink
                    UnProcessed.Remove (x)
                End If
            Next
        End If
    Next

Exit_Relink:
    Exit Function

Err_Relink:
    If Err.Number = 3043 Then
      MsgBox "Can not find the Master on the Network.  Check that you have a good network connection."
      Resume Exit_Relink
    Else
     Call ErrHandler(Err.Number, Err.Description, "Error in Relinktables")
     Resume Exit_Relink
    End If
End Function

Public Sub CheckifComplete()

    Dim strTest As String, y As String, notfound As String, x
    On Error GoTo Err_BeginLink
    
    ' If there are any names left in the unprocessed collection,
    ' then continue.
    If UnProcessed.Count > 0 Then
        For Each x In UnProcessed
            notfound = notfound & x & Chr(13)
        Next
        ' List the tables that have not yet been relinked.
        y = MsgBox("The following tables were not found in " & _
        Chr(13) & Chr(13) & strPath _
        & ":" & Chr(13) & Chr(13) & notfound & Chr(13) & _
        "Select another database that contains the additional tables?", _
        vbQuestion + vbYesNo, "Tables not found")
        
        If y = vbNo Then
            Exit Sub
        End If
        
        ' Bring the Common Dialog Control back up.
        strPath = fGetFileName
        strTest = strPath
        If Len(strTest) = 0 Then   ' File not found.
            MsgBox "File not found. Please try again.", vbExclamation, _
            "Link to new data file"
            Exit Sub
       End If
       Debug.Print "Break"
       Relinktables (strTest)
    Else
       Exit Sub
    End If
    
    CheckifComplete
    
Exit_BeginLink:
    DoCmd.Echo True   ' Just in case of error jump.
    DoCmd.Hourglass False
    Exit Sub

Err_BeginLink:
    Debug.Print Err.Number
    If Err.Number = 457 Then
        ClearAll
        Resume Next
    End If
    MsgBox Err.Number & ": " & Err.Description
    Resume Exit_BeginLink

End Sub
Public Sub linkToMaster()
   On Error GoTo errLbl:
    'I have a table in the front end that has the path
    'to the back end.  This could be hard coded.
    strPath = DLookup("BElocation", "tblDefault")
    ReProcessTables
    Exit Sub
errLbl:
   Call ErrHandler(Err.Number, Err.Description, "LinkToMaster")
End Sub

Public Sub linkToReplica()
  MsgBox "Pick the location of your replica database.", vbInformation, "Find Replica"
  strPath = fGetFileName()
  ReProcessTables
End Sub

Public Sub AppendAllTables()
    Dim db As DAO.Database, x As Variant
    Dim strTest As String
    ' Add names of all table with invalid links to the Unprocessed Collection.
    Set db = CurrentDb
    If Not UnProcessed Is Nothing Then
      ClearAll
    End If
    For Each x In db.TableDefs
        If Len(x.Connect) > 1 Then
        ' connect string exists, but file does not
             UnProcessed.Add Item:=x.Name, Key:=x.Name
        End If
    Next

End Sub
Public Function ReProcessTables()

    Dim strTest As String
    On Error GoTo Err_BeginLink
    
    ' Call procedure to add all tables with broken links into a collection.
    AppendAllTables
    
    ' Test for existence of file name\directory selected in Common Dialog Control.
    strTest = strPath
    
    On Error GoTo Err_BeginLink
    If Len(strTest) = 0 Then   ' File not found.
        MsgBox "File not found. Please try again.", vbExclamation, "Link to new data file"
        Exit Function
    End If
    
    ' Begin relinking tables.
    Relinktables (strTest)
    ' Check to see if all tables have been relinked.
    CheckifComplete
    
    DoCmd.Echo True, "Done"
    If UnProcessed.Count < 1 Then
         MsgBox "Linking to new back-end data file was successful."
    Else
         MsgBox "Not All back-end tables were successfully relinked."
    End If
    
   
Exit_BeginLink:
    DoCmd.Echo True
    Exit Function
    
Err_BeginLink:
    Debug.Print Err.Number
    If Err.Number = 457 Then
        ClearAll
        Resume Next
    End If
    MsgBox Err.Number & ": " & Err.Description
    Resume Exit_BeginLink

End Function

So here is the code in my hidden "frmLink" at startup

Private Sub Form_Open(Cancel As Integer)
   
      ' Tests a linked table for valid back-end.
      On Error GoTo Err_Form_Open
      
      Dim strTest As String, db As DAO.Database
      Dim td As DAO.TableDef
      DoCmd.RunCommand acCmdAppMaximize
      DoCmd.Minimize
      Me.Visible = False
      Set db = CurrentDb
      Dim lngRtn As Long
      For Each td In db.TableDefs
         If Len(td.Connect) > 0 Then   ' Is a linked table.
            On Error Resume Next   ' Turn off error trap.
            strTest = Dir(Mid(td.Connect, 11))   ' Check file name.
            On Error GoTo Err_Form_Open   ' Turn on error trap.
            If Len(strTest) = 0 Then   ' No matching file.
              lngRtn = MsgBox("Couldn't find the back-end file " & _
                  Mid(td.Connect, 11) & "." & vbCrLf & vbCrLf & "Please choose your Replica that has your data tables.", _
                  vbExclamation + vbOKCancel + vbDefaultButton1, _
                  "Can't find backend data file.")
                 If lngRtn = vbOK Then
                     strPath = fGetFileName()   ' Open prompt form.
                     If Len(strPath) > 0 Then  ' user responded, put selection into text box on form.
                       'MsgBox strPath, vbInformation, "New Path"
                       Call ProcessTables
                     Else
                       MsgBox "No Back End Data Base Selected. Exiting Application", vbExclamation, "Must Select BE database."
                       DoCmd.Quit
                     End If
                     DoCmd.Close acForm, Me.Name
                     DoCmd.OpenForm "frmLogin", , , , , acDialog
                     Exit Sub                          ' to refresh links
               Else
                  MsgBox "The linked tables can't find their source. " & _
                  "Please log onto network and restart the application."
                  Exit Sub
               End If
            End If
         End If
      Next   ' Loop to next tabledef.
      'DoCmd.Close acForm, Me.Name
      DoCmd.OpenForm "frmLogin", , , , , acDialog
Exit_Form_Open:
      Exit Sub
Err_Form_Open:
      MsgBox Err.Number & ": " & Error.Description
      Resume Exit_Form_Open
 End Sub

 

[dhookom]

You can't link to a relative location. You can add code that tests the link and opens a file dialog to "find" the table file. Or you could possibly automate this if the location is relative.

Are all users opening the same front end file on the network? This is typically not a good practice. Consider giving each user their own copy of the application.

Duane
Hook'D on Access
MS Access MVP