MS Access, Linking backend tables using VB code over network - sql

Question

I have made a Tracking Database for work that has a front end interface and backend tables. Right now I have a section of code which upon start up will link the front end with the back end tables so people can copy and paste the front end from "G:\Sections\MEO\DDPO\Active Issues\Tracking Database" to their desktop and it will still be able to access the backend file.
The Issue I want to avoid is if someone changes the file path of where the back end is located the front end will not be able to find the backend.
example:
Original Path G:\Sections\MEO\DDPO\Active Issues\Tracking Database\Database Backend\tracking Database_be.accdb
If someone Modified the Path
G:\New Sections\MEO\DDPO\Active Issues\Tracking Database\Database Backend\tracking Database_be.accdb
This is the current code I use for the front end to ensure it links to the backend upon start up.
Private Function ReconnectTables() As Boolean
On Error Resume Next
Dim tdf As DAO.TableDef
Dim dbs As DAO.Database
Dim strPath As String
Dim strConnect As String
Set dbs = CurrentDb
strPath = dbs.Name
strPath = "G:\Sections\MEO\DDPO\Active Issues\Tracking Database\Database Backend\tracking Database_be.accdb"
strConnect = strPath
For Each tdf In dbs.TableDefs
If tdf.Connect <> "" Then
tdf.Connect = ";DATABASE=" & strConnect
tdf.RefreshLink
End If
Next
Set dbs = Nothing
If Err.Number = 0 Then ReconnectTables = True
End Function

Answer 1

I ended up removing the hard written path from the code and added a line where it checks a value in a table. That value stored in the table is the path which the user can select in a separate form which now gets called if it detects the tables are not linked.
My new code looks like this:
Private Function ReconnectTables() As Boolean
On Error Resume Next
Dim tdf As DAO.TableDef
Dim dbs As DAO.Database
Dim strPath As String
Dim strConnect As String
Set dbs = CurrentDb
strPath = dbs.Name
strPath = me.BackEndPath.Value
strConnect = strPath
For Each tdf In dbs.TableDefs
If tdf.Connect <> "" Then
tdf.Connect = ";DATABASE=" & strConnect
tdf.RefreshLink
End If
Next
Set dbs = Nothing
If Err.Number = 0 Then ReconnectTables = True
End Function
I used to just have a message box that would pop up if the tables were not linked but now I added 2 lines of code to open a form (frmBEpath) if the tables are not linked.
Private Sub Form_Load()
On Error Resume Next
'DoCmd.ShowToolbar "Ribbon", acToolbarNo
If ReconnectTables() = True Then
strVerClient = Nz(DLookup("[VersionNumber]", "[tblVersionClient]"), "")
strVerServer = Nz(DLookup("[VersionNumber]", "[tblVersionServer]"), "")
Me.Repaint
Else
'MsgBox "Couldn't Find Data Tables. Exiting.", vbCritical, "Error"
DoCmd.Close
DoCmd.OpenForm "frmBEpath"
End If
End Sub
This new form tells the user the tables are not linked and it gives them a button to browse for the backend files. When they select the backend file and click the yes button it stores the path name in a table.
Option Compare Database
Public Function FolderSelection() As String
Dim objFD As Object
Dim strOut As String
strOut = vbNullString
Set objFD = Application.FileDialog(3)
If objFD.Show = -1 Then
strOut = objFD.SelectedItems(1)
End If
Set objFD = Nothing
FolderSelection = strOut
End Function
Private Sub btnBrowse_Click()
Dim strChoice As String
strChoice = FolderSelection
If Len(strChoice) > 0 Then
Me.txtPath = strChoice
End If
End Sub
Private Sub btnConfirmYes_Click()
Me.BackEndPath.Value = Me.txtPath.Value
DoCmd.Close
DoCmd.OpenForm "frmsplash"
End Sub