Solved Check if the backend exists in a split database (1 Viewer)

zelarra821

Registered User.
Local time
Today, 14:56
Joined
Jan 14, 2019
Messages
803
Goodnight.

As I say in the matter, I have a divided database and I want to produce a procedure that tells me if the backend exists, and if it does not exist, to open a window to choose the path where it is located.

I have this code from @MajP, but I do not know how to remove the code that I do not need exactly for what I want, and what I am doing is chaining procedures and functions that may not work for me.

Code:
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 database backend that has your data tables.", _
                  vbExclamation + vbOKCancel + vbDefaultButton1, _
                  "Can't find backend data file.")
                 If lngRtn = vbOK Then
                     strPath = GetFileDialog()   ' 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 "f_MainMenu", , , , , 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 "f_mainMenu", , , , , acDialog
Exit_Form_Open:
      Exit Sub
Err_Form_Open:
      MsgBox Err.Number & ": " & Err.Description
      Resume Exit_Form_Open
 End Sub

My idea is to put it in a module to use it only in the split databases.

If you know of another simpler system, let me know.

Thanks a lot.
 

theDBguy

I’m here to help
Staff member
Local time
Today, 06:56
Joined
Oct 29, 2018
Messages
21,357
Hi. If the module does what you want, I don't see any harm in leaving in the parts you're not using. You might need them later.
 

isladogs

MVP / VIP
Local time
Today, 13:56
Joined
Jan 14, 2017
Messages
18,186
I agree.
However, if you do want to simplify the code, just test by running a check on one linked table e.g. DCount("*","YourLinkedTableName")
If the check returns a value, the linked table exists. If not an error will occur which you can handle with a suitable message
 

zelarra821

Registered User.
Local time
Today, 14:56
Joined
Jan 14, 2019
Messages
803
It is not in a module, but is in the event "On opening" the form.

However, if you do want to simplify the code, just test by running a check on one linked table e.g. DCount("*","YourLinkedTableName")
If the check returns a value, the linked table exists.
This is the first step. Now how do I set a new path for those tables?
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 09:56
Joined
May 21, 2018
Messages
8,463
That code
1. Checks if the path exits to a linked table.
2. If not brings up a file browser to browse to select a new path
3. Once you pick a new path it calls ProcessTables in a standard module to relink
4. If successful it open the main form, if not asks you to browse to another table.

Not quite sure what part of that you would want to get rid of. Makes zero sense to get rid of any of that logic.
 

zelarra821

Registered User.
Local time
Today, 14:56
Joined
Jan 14, 2019
Messages
803
Hello, I am using the database that I attach.

Not quite sure what part of that you would want to get rid of. Makes zero sense to get rid of any of that logic.
What I want to add the whole process in a single module, and call it from the "On opening" event of the form, not that part of the necessary code is executed in that event, can I explain it? That would make it easier for me to pass it from one database to another, since I would only have to export one module.
 

Attachments

  • Personnel Information Management System v13.zip
    1.5 MB · Views: 529

MajP

You've got your good things, and you've got mine.
Local time
Today, 09:56
Joined
May 21, 2018
Messages
8,463
You can get rid of the hidden form and have an autoexec macro that calls the relink.

Just call the relink_autoexec function from the auto exec macro. You also need file dialog code
Code:
Option Compare Database
Option Explicit

Dim UnProcessed As New Collection
Public strPath As String
Public Function Relink_AutoExec()
      ' 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
      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 database backend that has your data tables.", _
                  vbExclamation + vbOKCancel + vbDefaultButton1, _
                  "Can't find backend data file.")
                 If lngRtn = vbOK Then
                     strPath = GetFileDialog()   ' 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
                     Exit Function                     ' to refresh links
               Else
                  MsgBox "The linked tables can't find their source. " & _
                  "Please log onto network and restart the application."
                  Exit Function
               End If
            End If
         End If
      Next   ' Loop to next tabledef.
Exit_Form_Open:
      Exit Function
Err_Form_Open:
      MsgBox Err.Number & ": " & Err.Description
      Resume Exit_Form_Open
 End Function



Public Sub linkToBackend()
  MsgBox "Pick the location of your backend database.", vbInformation, "Find Database"
  strPath = GetFileDialog()
  ReProcessTables
End Sub
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.
    MsgBox strPath
    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 = GetFileDialog
        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 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
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 09:56
Joined
May 21, 2018
Messages
8,463
You also need file dialog code

Code:
Public Function GetFileDialog() As String
   ' Requires reference to Microsoft Office 11.0 Object Library.
   Dim fDialog As Office.FileDialog
   Dim varFile As Variant
   ' Set up the File Dialog.
   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
   With fDialog
      ' Allow user to make multiple selections in dialog box
      .AllowMultiSelect = False
      ' Set the title of the dialog box.
      .Title = "Please select Backend Database"
      ' Clear out the current filters, and add our own.
      .Filters.Clear
      .Filters.Add "Access Databases", "*.ACCDB"
      ' Show the dialog box. If the .Show method returns True, the
      ' user picked at least one file. If the .Show method returns
      ' False, the user clicked Cancel.
      If .Show = True Then
         'Loop through each file selected and add it to our list box.
        GetFileDialog = .SelectedItems(1)
        ' For Each varFile In .SelectedItems
        '    GetFileDialog = varFile
        ' Next
      Else
         MsgBox "You clicked Cancel in the file dialog box."
      End If
   End With
End Function

Not sure if I can make this any more simple, without holding your hand.
 

zelarra821

Registered User.
Local time
Today, 14:56
Joined
Jan 14, 2019
Messages
803
Like this is perfect. I had to add ErrHandler because it gave an error, and change the procedure to open the dialog to choose the file for the one I already have.

Thanks a lot.
 

Pac-Man

Active member
Local time
Today, 18:56
Joined
Apr 14, 2020
Messages
408
You can get rid of the hidden form and have an autoexec macro that calls the relink.

Just call the relink_autoexec function from the auto exec macro. You also need file dialog code
Code:
Option Compare Database
Option Explicit

Dim UnProcessed As New Collection
Public strPath As String
Public Function Relink_AutoExec()
      ' 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
      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 database backend that has your data tables.", _
                  vbExclamation + vbOKCancel + vbDefaultButton1, _
                  "Can't find backend data file.")
                 If lngRtn = vbOK Then
                     strPath = GetFileDialog()   ' 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
                     Exit Function                     ' to refresh links
               Else
                  MsgBox "The linked tables can't find their source. " & _
                  "Please log onto network and restart the application."
                  Exit Function
               End If
            End If
         End If
      Next   ' Loop to next tabledef.
Exit_Form_Open:
      Exit Function
Err_Form_Open:
      MsgBox Err.Number & ": " & Err.Description
      Resume Exit_Form_Open
End Function



Public Sub linkToBackend()
  MsgBox "Pick the location of your backend database.", vbInformation, "Find Database"
  strPath = GetFileDialog()
  ReProcessTables
End Sub
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.
    MsgBox strPath
    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 = GetFileDialog
        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 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
PMJI, does this code handle password protected backends too?
 

Users who are viewing this thread

Top Bottom