Automatic Error Handling in Access

[Lysander]

Thought I would give something back with a few articles. This article is a bit of code to add error handling. When I have time, I want to write articles on multilingual databases, and Access Security, but I'll start with something short and simple

This code was written in Access 2003 but should be valid in Access 2000

By default, when you start a new module, either in a form or report, or a global module, Access does not declare Option Explicit. This means a simple spelling mistake in your variable names could cause havoc with your code and you wont pick it up when you compile. All modules should have option explicit, and all variables should be explicitly declared. You can force Option Explicit on all new modules by opening a module and in the VBA window go to Tools / Options / Editor tab and tick Require Variable Declaration. This will put Option Explicit on all new modules.

When you start a new procedure, error handling is not added, you have to do it yourself. This is slow, tedious and repetative, exactly the sort of task a computer should do.

What I have written below are three procedures, designed to be run from the immediate window, that will add error handling to every bit of code, and add option explict to every module.

I now no longer write error handling, unless there is a special case. I just code all day, and run this routine at the end of the day to add all the error handling.

First important note. These procedures must be in their own module, I call mine basManualFunctions and then hard-code (as you will see below) "basManualFunctions" as the one module to exclude. You cant edit a module that is open and running code.

Feel free to use these procedures (at your own risk), modify, copy, even sell them if you want. Acknowledgement to Lytton Consultants Ltd would be appreciated, but not needed. I acknowledge Litwin and Getz, from whose books I got most of my Access ideas.

Oh yes, backup before running this.

The first procedure is SetAllErrorChecking.

This is fairly basic, it loops through all the modules and calls processmod for each one.

It then loops through all the forms and reports and does the same for each module they hold.

Note that neither of these procedures have error checking themselves. That is deliberate, they are meant to be run hands on, and if an error occurs, I want to debug the code by hand.

Sub SetAllErrorChecking()
'This opens all code and sets error checking
Dim cont As Container
Dim mdl As Module
Dim doc As Document
 
    Set cont = DBEngine(0)(0).Containers("Modules")
 
    For Each doc In cont.Documents
        If doc.Name <> "basManualFunctions" Then
            DoCmd.OpenModule doc.Name
            ' Return reference to Module object.
            Set mdl = Modules(doc.Name)
            processmod mdl
            DoCmd.Close acModule, doc.Name, acSaveYes
        End If
    Next doc
 
Dim i As Integer, j As Integer
Dim db As Database
Dim frm As Form, rpt As Report
 
    Set db = CurrentDb
    For i = 0 To db.Containers.Count - 1
        If db.Containers(i).Name = "Forms" Then
            For j = 0 To db.Containers(i).Documents.Count - 1
                DoCmd.OpenForm db.Containers(i).Documents(j).Name, acDesign
                Set frm = Forms(db.Containers(i).Documents(j).Name)
                processmod frm.Module
                DoCmd.Close acForm, db.Containers(i).Documents(j).Name, acSaveYes
                ' DoCmd.Close acForm, db.Containers(i).Documents(j).Name, acSaveNo
            Next
        End If
        If db.Containers(i).Name = "Reports" Then
            For j = 0 To db.Containers(i).Documents.Count - 1
                DoCmd.OpenReport db.Containers(i).Documents(j).Name, acDesign
                Set rpt = Reports(db.Containers(i).Documents(j).Name)
                processmod rpt.Module
                DoCmd.Close acReport, db.Containers(i).Documents(j).Name, acSaveYes
            Next
        End If
    Next
 
    Set db = Nothing
 
    Set mdl = Nothing
    Set doc = Nothing
    Set cont = Nothing
 
End Sub
 

Now we look at processmod, which takes a module as a parameter.

First I print the module name, then assume option explicit has not been set. I scan all the lines up to CountOfDeclarationLines looking for option explicit. If I find it, set boolGot to true.

If i dont find it, I insert Option Explicit as the 2nd line in the module.

Now I start looking for each procedure. I can't use the module functions, because they allow a procedure to start, with comment lines, before the actual Private Sub or Public Function statement.

I scan for each of the possible procedure start lines and when found, call processProc, passing the procedure name, type, startline

This is the code for processmod

Sub processmod(mdl As Module)
Dim intLine As Long, strLine As String, strProcName As String, intBrac As Integer
Dim boolGot As Boolean
 
    Debug.Print mdl.Name
    boolGot = False
    For intLine = 1 To mdl.CountOfDeclarationLines
        strLine = mdl.Lines(intLine, 1)
        If Trim(strLine) = "Option Explicit" Then boolGot = True
    Next
 
    If Not boolGot Then
        mdl.InsertLines 2, "Option Explicit"
        Debug.Print " Added Option Explicit"
    End If
    intLine = 0
 
    While intLine < mdl.CountOfLines - 1
        intLine = intLine + 1
        strLine = mdl.Lines(intLine, 1)
        If Left(strLine, 3) = "Sub" Then
            'We have a new Sub Routing
            strProcName = Right(strLine, Len(strLine) - 4)
            intBrac = InStr(strProcName, "(")
            strProcName = Left(strProcName, intBrac - 1)
            processProc strProcName, intLine, "Sub", mdl
        End If
        If Left(strLine, 10) = "Public Sub" Then
            'We have a new Sub Routing
            strProcName = Right(strLine, Len(strLine) - 11)
            intBrac = InStr(strProcName, "(")
            strProcName = Left(strProcName, intBrac - 1)
            processProc strProcName, intLine, "Sub", mdl
        End If
        If Left(strLine, 11) = "Private Sub" Then
            'We have a new Sub Routing
            strProcName = Right(strLine, Len(strLine) - 12)
            intBrac = InStr(strProcName, "(")
            strProcName = Left(strProcName, intBrac - 1)
            processProc strProcName, intLine, "Sub", mdl
        End If
        If Left(strLine, 8) = "Function" Then
            'We have a new Function Routing
            strProcName = Right(strLine, Len(strLine) - 9)
            intBrac = InStr(strProcName, "(")
            strProcName = Left(strProcName, intBrac - 1)
            processProc strProcName, intLine, "Function", mdl
        End If
        If Left(strLine, 15) = "Public Function" Then
            'We have a new Function Routing
            strProcName = Right(strLine, Len(strLine) - 16)
            intBrac = InStr(strProcName, "(")
            strProcName = Left(strProcName, intBrac - 1)
            processProc strProcName, intLine, "Function", mdl
        End If
        If Left(strLine, 16) = "Private Function" Then
            'We have a new Function Routing
            strProcName = Right(strLine, Len(strLine) - 17)
            intBrac = InStr(strProcName, "(")
            strProcName = Left(strProcName, intBrac - 1)
            processProc strProcName, intLine, "Function", mdl
        End If
    Wend
 
End Sub
 

Ok, so now we have the startline of a procedure, and have called processproc

ProcessProc assumes that you dont have error handling, and runs through the module until it finds End Sub or End Function.

It scans each line, looking for On Error. If it finds On Error anywhere in the procedure, it assumes you have error handling for this proc and ignores it. Thus, if you did not want error handling in a procedure, then you could add the comment line
' On Error no error handling here
and it would ignore that procedure.

If we find no error handling, we add the following

After the startline, we add
On Error Goto xxx_Err where xxx is the procedure name

At the end of the procedure we add the following lines. This can be tailored to your own error handling conditions

xxx_Exit:
Exit Sub (or Exit Function)
xxx_Err:
MsgBox Err.Description & "in xxx"
Resume xxx_Exit

Finally print out "added error handling" so I can see what has been added when all done.

So here is processproc

Sub processProc(ByVal strProcName As String, ByVal intStartLine As Long, ByVal strSubFunc As String, ByRef mdl As Module)
Dim intThisLine As Integer, boolGot As Boolean, intLastLine As Integer, strText As String
 
    boolGot = False
    intThisLine = intStartLine
    While mdl.Lines(intThisLine, 1) <> "End " & strSubFunc
        intThisLine = intThisLine + 1
        If InStr(mdl.Lines(intThisLine, 1), "On Error") > 0 Then boolGot = True
    Wend
    intLastLine = intThisLine
    If Not boolGot Then
        Debug.Print " " & strProcName
        strText = strProcName & "_Exit:" & vbCrLf
        strText = strText & " Exit " & strSubFunc & vbCrLf
        strText = strText & strProcName & "_Err:" & vbCrLf
        strText = strText & " MsgBox Err.Description & " & Chr(34) & " in " & strProcName & Chr(34) & vbCrLf
        strText = strText & " Resume " & strProcName & "_Exit"
        mdl.InsertLines intLastLine, strText
        mdl.InsertLines intStartLine + 1, "On Error Goto " & strProcName & "_Err"
        Debug.Print " Added Error Handling"
    End If
 
End Sub
 

So copy the code, open the immediate window, type SetAllErrorChecking and enjoy

Mark Fisher
Lytton Consultants Ltd