Updating an Access Backend MDBs structure using VBA code

(Updated 2010-09-27)

[ Main | Access | Tips ]

Lately I've been using the Compare'EM utility to do the grunt work of figuring out what was changed from one update of the backend to the next.  It's not perfect but it is a good utility. (2007-11-23)

Below is some sample VBA code which checks a stored version number in the BE and adds the tables, fields, indexes and relationships and then updates that stored version.  Hmm, ok so it doesn't add tables.   See the Temp Tables MDB for that code.  I haven't extensively tested this code so there may very well be some missing error handling.

This code only illustrates the basics.  Allen Browne mentions a much more complete set of objects and other things you need to watch out for in "back end question".   You may also find you need to run update/insert/delete queries to move data from one table to another and clean things up.  

Also consider the scenario where one user has your new updated front end which has update the backend logic but other users are still running the old FE.

As always when cutting and pasting code compile after you paste to see if there are any compile errors.  These will likely be caused by lines wrapping to the next line unexpectedly.  I will frequently cut and paste to Notepad just to ensure there is no extraneous garbage or weird formatting.  Paste Special, if available on your right click menu, may also help.

It has been suggested that I could use subroutine/function calls to replace the create fields and properties and create index lines.  Thus simplifying the main stream of code.

Function UpdateTableFieldDefns() As Boolean

Dim dbsUpdate As Database, wrkDefault As Workspace
Dim tdfUpdate As TableDef, tdfField As Field
Dim strMsg As String, intResponse As Integer, strSQL As String
Dim idxUpdate As Index, idxField As Field
Dim prpNew As Property, relNew As Relation
Dim tdfTable1 As TableDef, tdfTable2 As TableDef

On Error GoTo tagError
UpdateTableFieldDefns = False
Set wrkDefault = DBEngine.Workspaces(0)

' Add new fields and tables to backend
'   You will need to use your own method of determining the backend version number
If Forms![Global Options]!zVersionNumberData = 1.33 Then

    '  You will need to use your own method of determining the backend path and file name
    See Tables: Retrieve linked database namepath for some sample code.

    Set dbsUpdate = wrkDefault.OpenDatabase(<backend path and file name>, True)

    ' Update the Mailings table
    Set tdfUpdate = dbsUpdate.TableDefs("Mailings")
    With tdfUpdate
        Set tdfField = .CreateField("mType", dbLong)
        .Fields.Append tdfField
        tdfField.Properties.Append tdfField.CreateProperty("Caption", dbText, "Mailing Type")
        tdfField.Properties.Append tdfField.CreateProperty("Description", dbText, _
            "Null/1 Label/Mailing Label, 2-Excel")
    End With

' Update the Mailing Labels Header table
    Set tdfUpdate = dbsUpdate.TableDefs("Mailing Headers")
    With tdfUpdate
        Set tdfField = .CreateField("mhSequenceNbr", dbLong)
        .Fields.Append tdfField
        tdfField.Properties.Append tdfField.CreateProperty("Caption", dbText, "Sequence Nbr")

        Set tdfField = .CreateField("mhCommitteeID", dbLong)
        .Fields.Append tdfField
        tdfField.Properties.Append tdfField.CreateProperty("Caption", dbText, "Committee ID")

        Set idxUpdate = .CreateIndex("mhSequenceNbr")
        idxUpdate.Fields.Append idxUpdate.CreateField("mhMailingID")
        idxUpdate.Fields.Append idxUpdate.CreateField("mhSequenceNbr")
        idxUpdate.Unique = True
        .Indexes.Append idxUpdate

        Set idxUpdate = .CreateIndex("mhCommitteeID")
        idxUpdate.Fields.Append idxUpdate.CreateField("mhMailingID")
        idxUpdate.Fields.Append idxUpdate.CreateField("mhCommitteeID")
        .Indexes.Append idxUpdate

    End With

    ' Setup Mailing label and Committee ID relationship
    Set relNew = dbsUpdate.CreateRelation("MailingLabelCommittee", _
        "Committee", "Mailing Headers")
    relNew.Fields.Append relNew.CreateField("cID")
    relNew.Fields!cID.ForeignName = "mhCommitteeID"
    dbsUpdate.Relations.Append relNew

    '  You will need to update your version number schema somehow
    strSQL = "UPDATE zVersionNumberData SET zVersionNumberData = 1.34;"
    CurrentDb.Execute strSQL, dbFailOnError

End If

UpdateTableFieldDefns = True
Exit Function

tagError:
Select Case Err.Number
    Case 3262 ' Couldn't lock table '...'; currently in use by user '...' on machine '...'
        strMsg = "As the table or MDB is in use the new tables/fields can't be added." & vbCrLf & vbCrLf & _
        Err.Description & vbCrLf & vbCrLf & _
        "Click OK to try again or Cancel to exit the program."
        intResponse = MsgBox(strMsg, vbExclamation + vbOKCancel + vbDefaultButton2)
        If intResponse = vbOK Then
            Resume
        Else
            Exit Function
        End If
    Case 3191 ' Can't define field more than once.
        Resume Next
    Case 3219 ' Invalid operation. Happens when adding captions
        Resume Next
    Case 3284 ' Index already exists.
        Resume Next
    Case 3012 ' Object '...' already exists. Happens when adding indexes
        Resume Next
    Case Else
        MsgBox Err.Description
End Select

Exit Function
Resume

End Function

[ Splitting | Access | Main ]

   Auto FE Updater distribute new and updated Front End databases to your users with several mouse clicks.

Granite Fleet Manager - the best designed fleet maintenance tracking and management system available