PROJECT PERFECT
Project Management Software
Specialists in Project Infrastructure

Help improve the site. Take a 3 minute survey and receive a free ebook.

"Your top 5 PM Questions Answered"

Click Here

Sign up for our newsletter. Hear about new Project Management White Papers.

When you subscribe you can download a free eBook

Click Here to Join

Email a friend about this site

Get great free widgets at Widgetbox!

Home - Microsoft Access Development - Microsoft Access Tips

Sample Microsoft Access VBA

Adding a Field to a Linked Database Table

I have to admit I am always collecting odd procedures that I reuse. I usually dump them into a generic module that gets included in every database I build. The procedures below are a collection of ones I built over the years to do a number of things related to tables.

Most Access developers have rolled out a database with a backend file and later found they needed to change a table in the backend Access database. If there is only one installation, it is relatively easy to throw everyone off and make the changes. If like Project Perfect who have been selling Project Administrator software for about 15 years. there are tens of thousands of databases out there, it gets more complicated.

We developed the module below to add a field to the backend Access database from the frontend Access database. The trick is to import the table into the frontend, make the changes then export it to the backend overwriting the existing table. Of course you then need to link the table to the frontend.

Procedures - Brief Description

There are five procedures in the module.

subAddTableFields	Main calling procedure. After various checks, import, modifies and exports tables. Calls relink procedure.
funTableExists	Check a table by that name exists.
funGetLinkedDBName	By passing a table name you know exists, you can find the file name of the linked database.
subLinkToOneBETable	Links a file name in the backend database
funCheck4Nothing	Checks to see if a value is blank, null or zero.

Use the Add Field to Linked Table Procedure

You need to pass a few values to the procedure. They are:

strTableName	The name of the linked table (e.g. tblCustomers, tblProducts)
strFieldName	The name of the new field (e.g. CustomerType, ProductModel)
strFieldType	The type of field including any size (e.g. TEXT(20), LONG)
strIndex	This field is optional but can be used to set values such as nulls allowed or no nulls. (e.g. NULL)

Here is an example. We wanted to add a field called "Period" to a table called tblWeeklyReport. We had a weekly report but decided to let users set their own period in case they wanted to do a 2 weekly or monthly report. We decided to make the type long integer and as many people would be using the same number in the field (7 days or 14 days, we wanted to allow duplicates. This is the calling line for the procedure.

subAddTableField "tblWeeklyReport", "Period", "Long", "NULL"

The VBA Code

'---------------------------------------------------------------------------------------
' Procedure : subAddTableField
' Author : Neville Turbit
' Date : 21/01/2011
' Purpose : Add a new field to a linked table
'---------------------------------------------------------------------------------------
'

Public Sub subAddTableField(strTableName As String, strFieldName As String, strFieldType As String, Optional strIndex As String)

Dim dbs As Database
Dim strSQL As String
Dim strTablesDatabase As String
Dim tdfLinked As TableDef

On Error GoTo Error_subAddTableField

'---------------------------------------------------------------
' If the table does not exist, exit

If funTableExists(strTableName) = False Then
GoTo Exit_subAddTableField
End If

'---------------------------------------------------------------
' If a local table exists delete it. Checks if table is linked

strTablesDatabase = funGetLinkedDBName(strTableName)

If strTablesDatabase = CurrentDb.Name Then
DoCmd.DeleteObject acTable, strTableName ' Delete the table Could be left over from previous modification. Not likely but best to be safe.
End If

'---------------------------------------------------------------
' Check if the field exists. If it fails proceed with the table modification

On Error GoTo Insert_Field ' If error, the field does not exist

strSQL = "SELECT " & strTableName & "." & strFieldName & " FROM " & strTableName & ";"

Set dbs = CurrentDb
dbs.OpenRecordset strSQL, dbOpenSnapshot, dbSeeChanges

Exit_subAddTableField:
On Error GoTo 0
Exit Sub

Insert_Field:

'---------------------------------------------------------------
' Delete the link (not the table)

Set tdfLinked = dbs.TableDefs(strTableName) ' Select a table. If no database, this will fail.

DoCmd.DeleteObject acTable, tdfLinked.Name ' Delete the link to the table

'---------------------------------------------------------------
' Import, modify and export the table

DoCmd.TransferDatabase acImport, "Microsoft Access", strTablesDatabase, acTable, strTableName, strTableName

strSQL = "ALTER TABLE " & strTableName & " ADD COLUMN " & strFieldName & " " & strFieldType & " " & Nz(strIndex, "")

subRunUpdateQuery strSQL

DoCmd.TransferDatabase acExport, "Microsoft Access", strTablesDatabase, acTable, strTableName, strTableName

'---------------------------------------------------------------
' Relink the table

DoCmd.DeleteObject acTable, tdfLinked.Name ' Delete the link
subLinkToOneBETable strTableName, strTablesDatabase ' Relink the table
GoTo Exit_subAddTableField

Error_subAddTableField:

MsgBox "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Module Name: modReleaseSetup" & vbCrLf & _
"Type: Module" & vbCrLf & _
"Calling Procedure: subAddTableField" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description

Resume Exit_subAddTableField
Resume

End Sub

'---------------------------------------------------------------------------------------
' Procedure : funTableExists
' Author : Neville Turbit
' Date : 04/06/09
' Purpose : Check if the table is already in this Database
'---------------------------------------------------------------------------------------
'
Public Function funTableExists(strTblName As String) As Boolean

Dim dbs As Database
Dim tbl As TableDef
Dim dbsExist As Object

On Error GoTo Error_funTableExists

funTableExists = False

Set dbs = CurrentDb
Set dbsExist = dbs.TableDefs

'--------------------------------------------------------------
' Search for AccessObject objects in AllTables collection.

For Each tbl In dbsExist
     If tbl.Name = strTblName Then
          funTableExists = True ' Set the function to true
          GoTo Exit_funTableExists ' Quit if true
     End If

Next tbl

Exit_funTableExists:
On Error GoTo 0
Set dbsExist = Nothing ' Clean up
Exit Function

Error_funTableExists:
MsgBox "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Module Name: modGeneric" & vbCrLf & _
"Type: Module" & vbCrLf & _
"Calling Procedure: funTableExists" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description

Resume Exit_funTableExists
Resume

End Function

'---------------------------------------------------------------------------------------
' Procedure : funGetLinkedDBName
' Author : Neville Turbit
' Date : 10/11/2010
' Purpose : The funGetLinkedDBName() function requires the name of a
' linked Microsoft Access table, in quotation marks, as an
' argument. The function returns the full path of the originating
' database if successful, or returns 0 if unsuccessful.
'---------------------------------------------------------------------------------------
'
Public Function funGetLinkedDBName(TableName As String)

Dim dbs As DAO.Database
Dim varReturn As Variant

On Error GoTo Error_NoTable ' Handles table not found

'---------------------------------------------------------------
' Find the table

Set dbs = CurrentDb()
varReturn = dbs.TableDefs(TableName).Connect

On Error GoTo Error_funGetLinkedDBName ' Normal error handling

'---------------------------------------------------------------
' Remove the "Database=" from the returned value

funGetLinkedDBName = Right(varReturn, Len(varReturn) - (InStr _
(1, varReturn, "DATABASE=") + 8))

Exit_funGetLinkedDBName:
On Error GoTo 0
Exit Function

Error_NoTable:
funGetLinkedDBName = "0"
GoTo Exit_funGetLinkedDBName

Error_funGetLinkedDBName:
MsgBox "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Module Name: modGeneric" & vbCrLf & _
"Type: Module" & vbCrLf & _
"Calling Procedure: funGetLinkedDBName" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description

Resume Exit_funGetLinkedDBName
Resume

End Function

'---------------------------------------------------------------------------------------
' Procedure : subLinkToOneBETable
' Author : Neville Turbit
' Date : 21/01/2011
' Purpose : Link one back end table
'---------------------------------------------------------------------------------------
'

Public Sub subLinkToOneBETable(strTableName As String, strBEPath As String)

Dim dbs As Database
Dim tdf As TableDef ' Tables in this database
Dim tdfLinked As TableDef ' Tables in back end database
Dim strPW As String

'--------------------------------------------------------------
' Check it is a valid path

On Error GoTo Error_subLinkToOneBETable

If funFileExists(strBEPath) = False Then
      Call MsgBox("The path provided for the back end database is incorrect. Please       ensure the correct path is provided. " _
      & vbCrLf & "" _
      & vbCrLf & "See your System Administrator." _
      , vbCritical, "Missing Database")

GoTo Exit_subLinkToOneBETable

End If

'--------------------------------------------------------------
' Clean up

Set tdf = Nothing
Set dbs = Nothing

'--------------------------------------------------------------
' Relink the files

Set dbs = OpenDatabase(strBEPath, False, False) ' This will fail if there is a password on the BE
Set tdfLinked = dbs.TableDefs(strTableName) ' Select a table. If no database, this will fail.

If funCheck4Nothing(tdfLinked.Name) = True Then ' No tabledef exists
     strPW = InputBox("Please enter the database password." & _
     " If you do not know the password, see your System Administrator.", _
     "Database Password") ' Ask for the password

Set dbs = OpenDatabase(strBEPath, False, False, ";pwd=" & strPW) ' Open the database using the password
End If

If funTableExists(tdfLinked.Name) Then
DoCmd.DeleteObject acTable, tdfLinked.Name
End If

DoCmd.TransferDatabase acLink, "Microsoft Access", _
strBEPath, acTable, tdfLinked.Name, tdfLinked.Name ' Link the table

DoCmd.Hourglass False

Exit_subLinkToOneBETable:
On Error GoTo 0
Exit Sub

Error_subLinkToOneBETable:
MsgBox "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Module Name: modGeneric" & vbCrLf & _
"Type: Module" & vbCrLf & _
"Calling Procedure: subLinkToOneBETable" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description

Resume Exit_subLinkToOneBETable
Resume

End Sub

'---------------------------------------------------------------------------------------
' Procedure : funCheck4Nothing
' Author : Neville Turbit
' Date : 04/06/09
' Purpose : Check the value passed is null, zero string ("") or zero. Returns true if any of these.
'---------------------------------------------------------------------------------------
'
Public Function funCheck4Nothing(var As Variant)
On Error GoTo Error_funCheck4Nothing

If IsNull(var) Or var = "" Or var = 0 Then
funCheck4Nothing = True
Else
funCheck4Nothing = False
End If

Exit_funCheck4Nothing:
On Error GoTo 0
Exit Function

Error_funCheck4Nothing:

MsgBox "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Module Name: modGeneric" & vbCrLf & _
"Type: Module" & vbCrLf & _
"Calling Procedure: funCheck4Nothing" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description

Resume Exit_funCheck4Nothing
Resume

End Function

Calling the Procedure

The easiest way to do this is to use the autoexec macro to call a function. The function in turn calls the subroutine to add the field. We have a function that calls a number of procedures to do things like confirm registration details, check for updates online for the program and also run any maintenance. A procedure called subMaintenance calls any fixes or database structure changes. By putting any change routines in subMaintenance we can quickly see what maintenance needs to run for each release.

The sequence is:

autoexec macro calls a function called funInitialise.
funInitialise calls a number of other procedures to check for updates, validate registration, set user security etc. One of those procedures called is subMaintenance.
subMaintenance runs the table modification.

If the Field Exists

Once the change has taken place, the procedure will continue to run. At the start of the procedure, the program looks for the table. If it finds it, it looks for the field to be added. If it finds the field, it exits. If running the SQL query causes an error it means it cannot find the field. In this case the update part of the procedure runs.

Add Comments

If you would like to comment on this article, click here.

Return to the top