DMW logo
tel 01732 833085
Tonbridge · Kent · UK

How at Start-up to Link Access Database Front End to Back End Tables

A VBA program to link at start-up the FE (front end) of a split Access database to the data tables in the BE (back end).

Last updated on 2020-11-23 by David Wallis.


Preface

The original article on this topic is How to Link at Startup Tables in an Access Split Database. In concluding that article I remark that the VBA described in it is a bit heavy on code. The page you’re reading describes my effort to lighten the load.

Please read the original article for observations on the adoption of split databases; on the need at all for any such start-up routine; and on use of a “KEY” file that any non-programmer could edit to point FE at BE.


Start-up Program Structure

The program that checks the links to tables resides in the FE. This program sub procedure, subDmwStartUpProgram(), determines the sequence of VBA sub-procedures, each performing a discrete operation in the overall linking process.

This is the structure of the subDmwStartUpProgram() program comprising of four main sub procedures:

Sub subDmwStartUpProgram()

' 1) Check for presence of BE file

fnDmwBlnFile

' 2) Make a list of tables to be linked

fnDmwFillLinkedTablesArray

' 3) Delete any existing links

fnDmwDeleteLinkedTables

' 4) Re-link FE to tables in BE

fnDmwReLinkTables

End Sub

fnDmwBlnFile() A general-purpose function procedure for checking the existence of a given file. It’s called to check that the BE file is where it is expected to be.

fnDmwFillLinkedTablesArray() This VBA function produces a list of the tables in the BE.

fnDmwDeleteLinkedTables() This VBA function deletes any links that the FE has to external tables. This makes sure that the FE gets a fresh set of links and demolishes any legacy links that may be hanging around and therefore are no longer relevant.

fnDmwReLinkTables() This VBA function creates fresh links to those tables in the BE file that have been listed by fnDmwFillLinkedTablesArray().

If, at any point in the program, one of the functions returns an error signal, then subDmwStartUpProgram() stops any use of the database, and presents an explanatory message to the user, which can be passed on in anticipation of technical attention to the problem.

The VBA code for each of the functions appears below, followed by the fully-fledged subDmwStartUpProgram() program.

The part this function plays in the overall program is to check for the presence of the BE file.


1) Checking Existence of a File

The function fnDmwBlnFile() determines whether a file exists at the location supplied to its file$ argument.

Function fnDmwBlnFile(file$) As Boolean

On Error Resume Next

Dim attrib&

attrib& = GetAttr(file$)

fnDmwBlnFile = _

(Err.Number = 0) _

And ((attrib& And vbDirectory) = 0)

End Function

fnDmwBlnFile() returns TRUE if it locates the file in the stated folder, FALSE if it doesn't.


2) List the Tables in Back End

fnDmwFillLinkedTablesArray() fills an array tbls$. This array has eight rows in this example corresponding to eight tables in the BE file.

tbls$ has three columns. The first holds the names of the tables as they appear in the BE. The second, the names of those tables as you want them to appear in the FE when they are linked in.

The third column holds the path to the BE file, passed to fnDmwFillLinkedTablesArray() by way of its BE$ argument.

For this example the third column is overkill. But it's there should you ever need to link to tables in different back ends. Should you, include an argument for each BE.

Function fnDmwFillLinkedTablesArray(ByVal BE$) As Long

On Error GoTo errHandler

Dim resp&

ReDim tbls$(8, 3)

tbls$(1, 1) = "tblAddress"

tbls$(2, 1) = "tblOrganisation"

tbls$(3, 1) = "tblOrganisationAddress"

tbls$(4, 1) = "tblOrganistionPerson"

tbls$(5, 1) = "tblPerson"

tbls$(6, 1) = "tblPersonAddress"

tbls$(7, 1) = "tblPersonEmail"

tbls$(8, 1) = "tluEmailPurpose"

tbls$(1, 2) = "tblAddress"

tbls$(2, 2) = "tblOrganisation"

tbls$(3, 2) = "tblOrganisationAddress"

tbls$(4, 2) = "tblOrganistionPerson"

tbls$(5, 2) = "tblPerson"

tbls$(6, 2) = "tblPersonAddress"

tbls$(7, 2) = "tblPersonEmail"

tbls$(8, 2) = "tluEmailPurpose"

tbls$(1, 3) = BE$

tbls$(2, 3) = BE$

tbls$(3, 3) = BE$

tbls$(4, 3) = BE$

tbls$(5, 3) = BE$

tbls$(6, 3) = BE$

tbls$(7, 3) = BE$

tbls$(8, 3) = BE$

resp& = 0

procDone:

fnDmwFillLinkedTablesArray = resp&

Exit Function

errHandler:

resp& = Err.Number

Resume procDone

End Function

fnDmwFillLinkedTablesArray() returns a zero if it completes the array. If it fails, it returns the number of the error that its error handler identifies.

Making a List of Names of Tables to Include in the Array

Since all the tables to which you want the FE to link are in the BE, the best place to make a list of them is in the BE. So introduce this procedure into a module in the BE:

Sub subDmwListTablesInBackEnd() As String

On Error GoTo errHandler

Dim tbl As AccessObject, db As Object

Dim msg$

Set dB = Application.CurrentData

For Each tbl In db.AllTables

If Not Left(tbl.Name, 4) = "MSys" Then Debug.Print tbl.Name

Next tbl

msg$ = "Table listing complete"

procDone:

MsgBox msg$, vbInformation, "Table Listing"

Exit Sub

errHandler:

msg$ = Err.Number & " " & Err.Description

Resume procDone

End Sub

In your BE’s VBE Immediate Window, input Call subDmwListTablesInBackEnd and press enter. The procedure will list all the tables in the Window from where you can copy them.

Filling the Array of Tables

You can use Excel to create the entries for the array used by fnDmwFillLinkedTablesArray(). In Excel, paste a list of the table names into Column A. Then to make the first dimension in your array, copy and paste this formula into Cell B1 and copy it down:

=CONCAT("tbls$(",ROW(),",1)=""",A1,"""")

Table array

To create the second dimension, copy and paste this formula into Cell C1 and copy it down:

=CONCAT("tbls$(",ROW(),",2)=""",A1,"""")

Table array

For the third dimension, copy and past this formula into Cell D1 and copy it down:

=CONCAT("tbls$(",ROW(),",3)=","BE$")

Table array

Finally, copy and paste the content of Columns B, C and D in turn into fnDmwFillLinkedTablesArray().


3) Delete Current Table Links

Before initiating linking of BE tables into the FE, I opt to delete existing links so that linking can start from a clean sheet. This way any tables that are no longer relevant — perhaps those at sometime introduced during the development of a database — are permanently removed.

An Access database has a number of tables in addition to the ones you introduce. One of these is MSysObjects. The SQL$ query in fnDmwDeleteLinkedTables() filters MSysObjects for those table objects that are of Type 6, i.e. linked tables.

Without exception, I use these prefixes in all the databases I create; hence I can rely on them for this procedure to work.

Function fnDmwDeleteLinkedTables() As Long

On Error GoTo errHandler

Dim rs As DAO.Recordset, SQL$

Dim tdf As TableDef

Dim db As DAO.Database

Dim i&, n%

SQL$ = _

"SELECT MSysObjects.Name FROM MSysObjects " & _

"WHERE ((MSysObjects.Type)=6);"

Set db = CurrentDb

Set rs = db.OpenRecordset(SQL$, dbOpenSnapshot)

If rs.RecordCount > 0 Then

rs.MoveLast

n% = rs.RecordCount

' Create array of linked tables

ReDim rsTbls(n%)

rs.MoveFirst

i& = 0

Do While Not rs.EOF

i& = i& + 1

rsTbls(i&) = rs!Name

rs.MoveNext

Loop

n% = i&

rs.Close

Set rs = Nothing

' Delete links to tables listed in array

For i& = 1 To n%

Set tdf = db.TableDefs(rsTbls(i&))

db.TableDefs.Delete rsTbls(i&)

Set tdf = Nothing

Next i&

End If

i& = 0

procDone:

fnDmwDeleteLinkedTables = i&

On Error Resume Next

If Not tdf is Nothing Then Set tdf = Nothing

If Not rs Is Nothing Then

rs.Close

Set rs = Nothing

End If

If Not db Is Nothing Then Set db = Nothing

errHandler:

i& = Err.Number

Resume procDone

End Function

fnDmwDeleteLinkedTables() returns a zero if it completes satisfactorily. If it fails, then it returns the number of the error that its error handler identifies.


4) Re-link FE to Tables in BE

fnDmwReLinkTables() performs the linking of the tables contained in the array of table named in the tbls$ array generated by fnDmwFillLinkedTablesArray().

Function fnDmwReLinkTables() As Long

On Error GoTo errHandler

Dim db As DAO.Database

Dim tdf As TableDef

Dim i&

Set db = CurrentDb

For i& = 1 To UBound(tbls$())

Set tdf = db.CreateTableDef(tbls$(i&, 2))

tdf.Connect = ";DATABASE=" & tbls$(i&, 3) & ";"

tdf.SourceTableName = tbls$(i&, 1)

db.TableDefs.Append tdf

Set tdf = Nothing

Next i&

procDone:

fnDmwReLinkTables = i&

On Error Resume Next

If Not tdf is Nothing Then Set tdf = Nothing

If Not db Is Nothing Then

db.Close

Set db = Nothing

End IF

Exit Function

errHandler:

i& = Err.Number

Resume procDone

End Function

fnDmwReLinkTables() returns a zero if it completes satisfactorily. If it fails, it returns the number of the error that its error handler identifies.


The Controlling Procedure

In databases I create I place the code described in this article in a module named modStartUp. There are four local module-level constants and variables to declare: pathBE$$, BE$, tbls$() and frmNane$$.

Option Compare Database

Option Explicit

Private Const pathBE$ = "D:\Database\DATA.accdb"

Private tbls$()

Private tblName$

Private Const frmNane$ = "frmNavigation"


Sub subDmwStartUpProgram()

On Error GoTo errHandler

Dim resp&

Dim msg$, icon&, title$

Dim tblMissing$

title$ = "ERROR LINKING TABLES"

icon& = vbExclamation + vbOKOnly

msg$ = _

"An error in its start-up program is " & _

preventing the database from opening. " & _

"Please make screen shot " & _

"or note of the following details." & _

vbCrLf & vbCrLf

' (1)

If Not fnDmwBlnFile(pathBE$) Then

msg$ = msg$ & _

"DATA file not located at " & pathBE$

MsgBox msg$, icon&, title$

Application.Quit acQuitSaveNone

End If

' (2)

resp& = fnDmwFillLinkedTablesArray()

If resp& <> 0 Then

title$ = "ERROR LISTING LINKED TABLES"

msg$ = msg$ & _

"Error Source: " & vbCrLf &_

"fnDmwFillLinkedTablesArray()" & _

vbCrLf & vbCrLf & _

"Error Number: " & vbCrLf & _

resp& & _

vbCrLf & vbCrLf & _

"Description: " & vbCrLf & _

AccessError(resp&)

MsgBox msg$, icon&, title$

Application.Quit acQuitSaveNone

End If

' (3)

resp& = fnDmwDeleteLinkedTables()

If resp& <> 0 Then

title$ = "ERROR CLEARING TABLE LINKS"

msg$ = msg$ & _

"Error Source: " & vbCrLf & _

fnDmwDeleteLinkedTables()" & _

vbCrLf & vbCrLf & _

"Error Number: " & vbCrLf & _

resp& & _

vbCrLf & vbCrLf & _

"Description: " & vbCrLf & _

AccessError(resp&)

MsgBox msg$, icon&, title$

Application.Quit acQuitSaveNone

End If

' (4)

resp& = fnDmwReLinkTables()

If resp& <> 0 Then

title$ = "ERROR LINKING TO TABLES IN DATA FILE"

msg$ = msg$ & _

"Error Source:" & vbCrLf & _

"fnDmwReLinkTables()" & _

vbCrLf & vbCrLf & _

"Error Number:" & vbCrLf & _

resp& & _

vbCrLf & vbCrLf & _

"Description:" & vbCrLf & _

AccessError(resp&) & _

vbCrLf & vbCrLf & _

"Object Variable '|':" & vbCrLf & _

"[" & tblName$ & "]"

MsgBox msg$, icon&, title$

Application.Quit acQuitSaveNone

End If

DoCmd.OpenForm frmNane$

procDone:

Exit Sub

errHandler:

title$ = "ERROR AT START UP"

icon& = vbCritical

msg$ = msg$ & _

"Error Source:" & vbCrLf & _

"dmwStartUpProgam()" & _

vbCrLf & vbCrLf & _

"Error Number:" & vbCrLf & _

resp& & _

vbCrLf & vbCrLf & _

"Description:" & vbCrLf & _

AccessError(Err.Number)

MsgBox msg$, icon&, title$

Resume procDone

End Function

On successful completion subDmwStartUpProgram() opens the form, in this example named frmNavigation. Should the program fail it closes Access altogether after presenting the user with a message explaining why.


Your Support for DMW TIPS

Please support this website by making a donation to help keep it free of advertising and to help towards cost of time spent adding new content.

To make a contribution by PayPal in GBP (£ sterling) —

To make a contribution by PayPal in USD ($ US) —

If you’d like an invoice to account for your donation, let me know how much you’re donating —

Invoice

Thanks, in anticipation.

SSL Cerification

“Everything that can be invented has been invented.”

Charles H. Duell, Commissioner, U.S. Office of Patents, 1899