By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,835 Members | 1,959 Online
Bytes IT Community
Submit an Article
Got Smarts?
Share your bits of IT knowledge by writing an article on Bytes.

Automatic Error Handling in Access

Expert 100+
P: 344
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.

Expand|Select|Wrap|Line Numbers
  1. Sub SetAllErrorChecking()
  2. 'This opens all code and sets error checking
  3. Dim cont As Container
  4. Dim mdl As Module
  5. Dim doc As Document
  6.  
  7.     Set cont = DBEngine(0)(0).Containers("Modules")
  8.  
  9.     For Each doc In cont.Documents
  10.         If doc.Name <> "basManualFunctions" Then
  11.             DoCmd.OpenModule doc.Name
  12.             ' Return reference to Module object.
  13.             Set mdl = Modules(doc.Name)
  14.             processmod mdl
  15.             DoCmd.Close acModule, doc.Name, acSaveYes
  16.         End If
  17.     Next doc
  18.  
  19. Dim i As Integer, j As Integer
  20. Dim db As Database
  21. Dim frm As Form, rpt As Report
  22.  
  23.     Set db = CurrentDb
  24.     For i = 0 To db.Containers.Count - 1
  25.         If db.Containers(i).Name = "Forms" Then
  26.             For j = 0 To db.Containers(i).Documents.Count - 1
  27.                 DoCmd.OpenForm db.Containers(i).Documents(j).Name, acDesign
  28.                 Set frm = Forms(db.Containers(i).Documents(j).Name)
  29.                 processmod frm.Module
  30.                 DoCmd.Close acForm, db.Containers(i).Documents(j).Name, acSaveYes
  31.                 ' DoCmd.Close acForm, db.Containers(i).Documents(j).Name, acSaveNo
  32.             Next
  33.         End If
  34.         If db.Containers(i).Name = "Reports" Then
  35.             For j = 0 To db.Containers(i).Documents.Count - 1
  36.                 DoCmd.OpenReport db.Containers(i).Documents(j).Name, acDesign
  37.                 Set rpt = Reports(db.Containers(i).Documents(j).Name)
  38.                 processmod rpt.Module
  39.                 DoCmd.Close acReport, db.Containers(i).Documents(j).Name, acSaveYes
  40.             Next
  41.         End If
  42.     Next
  43.  
  44.     Set db = Nothing
  45.  
  46.     Set mdl = Nothing
  47.     Set doc = Nothing
  48.     Set cont = Nothing
  49.  
  50. End Sub
  51.  
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
Expand|Select|Wrap|Line Numbers
  1. Sub processmod(mdl As Module)
  2. Dim intLine As Long, strLine As String, strProcName As String, intBrac As Integer
  3. Dim boolGot As Boolean
  4.  
  5.     Debug.Print mdl.Name
  6.     boolGot = False
  7.     For intLine = 1 To mdl.CountOfDeclarationLines
  8.         strLine = mdl.Lines(intLine, 1)
  9.         If Trim(strLine) = "Option Explicit" Then boolGot = True
  10.     Next
  11.  
  12.     If Not boolGot Then
  13.         mdl.InsertLines 2, "Option Explicit"
  14.         Debug.Print " Added Option Explicit"
  15.     End If
  16.     intLine = 0
  17.  
  18.     While intLine < mdl.CountOfLines - 1
  19.         intLine = intLine + 1
  20.         strLine = mdl.Lines(intLine, 1)
  21.         If Left(strLine, 3) = "Sub" Then
  22.             'We have a new Sub Routing
  23.             strProcName = Right(strLine, Len(strLine) - 4)
  24.             intBrac = InStr(strProcName, "(")
  25.             strProcName = Left(strProcName, intBrac - 1)
  26.             processProc strProcName, intLine, "Sub", mdl
  27.         End If
  28.         If Left(strLine, 10) = "Public Sub" Then
  29.             'We have a new Sub Routing
  30.             strProcName = Right(strLine, Len(strLine) - 11)
  31.             intBrac = InStr(strProcName, "(")
  32.             strProcName = Left(strProcName, intBrac - 1)
  33.             processProc strProcName, intLine, "Sub", mdl
  34.         End If
  35.         If Left(strLine, 11) = "Private Sub" Then
  36.             'We have a new Sub Routing
  37.             strProcName = Right(strLine, Len(strLine) - 12)
  38.             intBrac = InStr(strProcName, "(")
  39.             strProcName = Left(strProcName, intBrac - 1)
  40.             processProc strProcName, intLine, "Sub", mdl
  41.         End If
  42.         If Left(strLine, 8) = "Function" Then
  43.             'We have a new Function Routing
  44.             strProcName = Right(strLine, Len(strLine) - 9)
  45.             intBrac = InStr(strProcName, "(")
  46.             strProcName = Left(strProcName, intBrac - 1)
  47.             processProc strProcName, intLine, "Function", mdl
  48.         End If
  49.         If Left(strLine, 15) = "Public Function" Then
  50.             'We have a new Function Routing
  51.             strProcName = Right(strLine, Len(strLine) - 16)
  52.             intBrac = InStr(strProcName, "(")
  53.             strProcName = Left(strProcName, intBrac - 1)
  54.             processProc strProcName, intLine, "Function", mdl
  55.         End If
  56.         If Left(strLine, 16) = "Private Function" Then
  57.             'We have a new Function Routing
  58.             strProcName = Right(strLine, Len(strLine) - 17)
  59.             intBrac = InStr(strProcName, "(")
  60.             strProcName = Left(strProcName, intBrac - 1)
  61.             processProc strProcName, intLine, "Function", mdl
  62.         End If
  63.     Wend
  64.  
  65. End Sub
  66.  
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
Expand|Select|Wrap|Line Numbers
  1. Sub processProc(ByVal strProcName As String, ByVal intStartLine As Long, ByVal strSubFunc As String, ByRef mdl As Module)
  2. Dim intThisLine As Integer, boolGot As Boolean, intLastLine As Integer, strText As String
  3.  
  4.     boolGot = False
  5.     intThisLine = intStartLine
  6.     While mdl.Lines(intThisLine, 1) <> "End " & strSubFunc
  7.         intThisLine = intThisLine + 1
  8.         If InStr(mdl.Lines(intThisLine, 1), "On Error") > 0 Then boolGot = True
  9.     Wend
  10.     intLastLine = intThisLine
  11.     If Not boolGot Then
  12.         Debug.Print " " & strProcName
  13.         strText = strProcName & "_Exit:" & vbCrLf
  14.         strText = strText & " Exit " & strSubFunc & vbCrLf
  15.         strText = strText & strProcName & "_Err:" & vbCrLf
  16.         strText = strText & " MsgBox Err.Description & " & Chr(34) & " in " & strProcName & Chr(34) & vbCrLf
  17.         strText = strText & " Resume " & strProcName & "_Exit"
  18.         mdl.InsertLines intLastLine, strText
  19.         mdl.InsertLines intStartLine + 1, "On Error Goto " & strProcName & "_Err"
  20.         Debug.Print " Added Error Handling"
  21.     End If
  22.  
  23. End Sub
  24.  
So copy the code, open the immediate window, type SetAllErrorChecking and enjoy

Mark Fisher
Lytton Consultants Ltd
Jun 21 '07 #1
Share this Article
Share on Google+