Wrox Programmer Forums
Go Back   Wrox Programmer Forums > Microsoft Office > Access and Access VBA > Access VBA
Access VBA Discuss using VBA for Access programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Access VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
Old August 25th, 2004, 08:23 PM
rjp rjp is offline
Registered User
Join Date: Aug 2004
Posts: 9
Thanks: 0
Thanked 0 Times in 0 Posts
Default Error catching and throwing - code

If you want a better way of dealing with error the following module may be of use to you. Comments are appreciated. I will provide a sample test in the next post so you can give it a bash.

'Option Compare Database
Option Explicit

'************************************************* **
'AUTHOR: RJ Palmer
'COUNTRY: Australia
'OCCUPATION: Mechatronic engineer
'DATE: 26/8/04
'DESCRIPTION: Ever wanted a better way of handling errors in
' VBA? Well if you like JAVA's exceptions or writing especially
' complex code or temperamental data that you would like to follow all errors
' from there
' source up to the calling level then this might be good for you
'USAGE: Anyone can use or modify this code. A mention of my efforts in a
' lowly comment would be appreciated
'************************************************* ***

Private G_ERROR As MYERR 'the underlying error variables that stores the error

Private Const C_DELIM_SRC = "-->"
Private Const C_DELIM_DESCR = "-->"
Public Enum ERR_type 'my own personal set of error types (add your own)
    ERR_sql_exec 'sql execution error
End Enum
Private Type MYERR 'the underlying error variables type specification
    number As ERR_type
    descr As String
    source As String
    isErr As Boolean
End Type
'clears an error flag
Public Function ERR_clear()
    With G_ERROR
        .descr = ""
        .isErr = False
        .number = ERR_none
        .source = ""
    End With
End Function

Public Function ERR_getSysERRNum()
    ERR_getSysERRNum = err.number
End Function

'public sub ERR_raise2
Public Sub ERR_raise_blank()
    Call err.Raise(0, "", "", 0, 0) 'raise a dummy system error
End Sub

'raises a new error
Public Sub ERR_raise(number As ERR_type, source As String, descr As String)
    'Dim ERROR As ErrObject
    Static i As Integer
    Const C_ERR_RUNTIME = 1
    Dim FLAG_throwToFar As Boolean
    FLAG_throwToFar = True
    G_ERROR.descr = descr
    G_ERROR.isErr = True
    G_ERROR.source = source
    i = i + 1
    Call err.Raise(i, "", "", 0, 0) 'raise a dummy system error
End Sub
'Automatically determines whether to throw an error of raise a new one
Public Sub ERR_throw_auto(err As ERR_type, source As String, descr As String)
    If ERR_isThrow Then
        Call ERR_THROW(source, descr)
        'Call ERR_raise(err, source, descr)
        Call ERR_raise(err, source, descr)
    End If
End Sub

Public Sub ERR_THROW(source As String, descr As String)
    Static id As Integer
    id = id + 1
    Call ERR_raise(G_ERROR.number, G_ERROR.source & C_DELIM_SRC & "(" & id & ")" & source, _
                    G_ERROR.descr & C_DELIM_DESCR & "(" & id & ")" & descr)
End Sub
Public Function ERR_isThrow() As Boolean
    ERR_isThrow = G_ERROR.isErr And Not G_ERROR.number = ERR_none
End Function

Public Function ERR_toString() As String
    Dim s As String, number As ERR_type
    Const CASE_L = "<": Const CASE_R = ">"
    Select Case number
        Case ERR_type.ERR_arithmetic
            s = "ERR_ARITHMETIC"
        Case ERR_type.ERR_GENERAL
            s = "ERR_GENERAL"
        Case ERR_type.ERR_incompat
            s = "ERR_INCOMPATIBLE_TYPES"
        Case ERR_type.ERR_NOTFOUND
            s = "ERR_NOTFOUND"
        Case ERR_type.ERR_overflow
            s = "ERR_OVERFLOW"
        Case ERR_type.ERR_unexpected
            s = "ERR_UNEXPECTED"
        Case Else
            s = "NOT VALID ERROR" 'default case
    End Select
    s = CASE_L & s & CASE_R
    s = s & " ::SRC::{ " & G_ERROR.source & " } ::DSCR::{ " & G_ERROR.descr & " } "
    ERR_toString = s
End Function

Public Sub ERR_msgbox()
    MsgBox ERR_toString, vbOKOnly, "EXCEPTION"
End Sub

Public Sub ERR_debug()
    Debug.Print "EXCEPTION>>> " & ERR_toString
End Sub

Old August 25th, 2004, 08:32 PM
rjp rjp is offline
Registered User
Join Date: Aug 2004
Posts: 9
Thanks: 0
Thanked 0 Times in 0 Posts

Shove the following previous posts code in a module and the following test code in another module.

either run


from a subroutine or in the immediate window. The code is especially good for database work. It saved me a lot of time because any unexpected/new errors come with description and a error trace.
'Gold Jerry, Gold'

the output will be something like:

EXCEPTION>>> <ERR_NOTFOUND> ::SRC::{ lowestest-->(1)lowest-->(2)lower } ::DSCR::{ Error while calculating i (could put variable values in here)-->(1)Error while calling function-->(2)Error while calling function }

SRC = source of the error and a trace of the functional/sub calls that it passed through
DSCR = description of erro at every level
(#) = error trace level

And now for the test code:

'***********************EXAMPLE******************* *******************

Public Sub lowestest()
    Const C_FUNCTION = "lowestest"
    Dim i As Integer
    i = 0
    On Error GoTo ERR_CATCH
    i = 10 / i 'create an error
    'Call ERR_raise(ERR_GENERAL, "lowestest", "test error")
    'Call ERR_throw(ERR_GENERAL, "lowestest", "test error")
    'automatically determines whether this is a new error or whether this is a caught error that
    'we are throwing again
    Call ERR_throw_auto(ERR_GENERAL, C_FUNCTION, "Error while calculating i (could put variable values in here)")
End Sub

Public Sub lowest()
    Const C_FUNCTION = "lowest"
   On Error GoTo catch
    Call lowestest
    Call ERR_throw_auto(ERR_GENERAL, C_FUNCTION, "Error while calling function")
End Sub

Public Sub lower()
    Const C_FUNCTION = "lower"
    On Error GoTo catch
    Call lowest
    Call ERR_throw_auto(ERR_GENERAL, C_FUNCTION, "Error while calling function")
End Sub

Public Sub upper()
    Const C_FUNCTION = "upper"
    On Error GoTo ERR_REPORT

    Call lower

    Call ERR_msgbox 'report error
    Call ERR_debug 'alternate way of reporting error
End Sub
'************************************************* **********************

Similar Threads
Thread Thread Starter Forum Replies Last Post
Catching a SQLException error digriz60 ASP.NET 1.0 and 1.1 Basics 5 January 14th, 2008 03:14 PM
Throwing error back to main thread AgentSmith General .NET 0 April 26th, 2006 09:14 AM
catching error darkhalf Javascript 4 December 14th, 2005 01:44 PM
throwing exceptions...!? jacob ASP.NET 1.0 and 1.1 Basics 3 October 9th, 2003 03:37 PM
catching error fyeojo VS.NET 2002/2003 4 August 13th, 2003 08:29 PM

Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.