Custom Error Object

Ken Puls and I were discussing the merits of custom class modules recently. Shortly after that conversation, I started rewriting a small utility app with the intention of using the Rethrow method mention by Stephen Bullen. If I’m such a class module evangelist, why am I not using a custom error object? Good question.

I decided to rewrite the PED Error Handler using a class. Below is the central error handling function with more comments than are necessary, I think.

Public Function HandleError(ByVal sModule As String, ByVal sProc As String, _
Optional ByVal sFile As String, _
Optional ByVal bEntryPoint As Boolean = False) As Boolean

Dim bReturn As Boolean

'First call, the object will be nothing so it's created
'and the number and description are saved
If gclsError Is Nothing Then
Set gclsError = New CError
gclsError.Number = Err.Number
gclsError.Message = Err.Description
End If

'Once the error number and description are captured,
'suppress all other errors
On Error Resume Next

With gclsError
'Additional properties set
.Module = sModule
.Procedure = sProc
.File = sFile
.EntryPoint = bEntryPoint

'Method to write the error out to a file
.WriteToLog

If Not .UserCanceled Then
'If it's at the entry point or in debug, display the error
If .ShouldShowMessage Then
Application.ScreenUpdating = True
MsgBox .Message, vbCritical, gsAPPTITLE
Set gclsError = Nothing
Else
'Rethrow the error in the calling procedure
On Error GoTo 0
Err.Raise .Number, .FullSource, .Message
End If

bReturn = .DebugMode
Else
'End silently and kill the object
bReturn = False
Set gclsError = Nothing
End If
End With

HandleError = bReturn

End Function

This isn’t an exact replacement for the one in the book. It only uses the Rethrow method, so it won’t be a good solution if you need to clean up after an error. My goal was not to duplicate it exactly, but rather to kill some time during one of the less relevant MVP Summit sessions. Here are a couple of highlights:

I wrote a write-once property for the Message property. Later, I changed the main function to only write the Message property when a new CError object is created so it’s redundant.

Public Property Let Message(ByVal sMessage As String)

If Len(Me.Message) = 0 Then msMessage = sMessage

End Property

Writing to the log file uses some other custom properties that are basically string builders.

Public Sub WriteToLog()

Dim lFile As Long

On Error Resume Next

lFile = FreeFile

Open Me.LogFile For Append As lFile
Print #lFile, Format$(Now(), "dd mmm yy hh:mm:ss"); Me.LogEntry
If Me.EntryPoint Then
Print #lFile,
End If
Close lFile

End Sub

I modified the standard Let Number property to use a default “User Cancel” message.

Public Property Let Number(ByVal lNumber As Long)

mlNumber = lNumber
If lNumber = ErrorType.UserCancel Then
Me.Message = msUSERCANCEL
End If

End Property

One of the things I like about using class modules is turning Boolean logic into easy-to-understand English. I could have coded

If .DebugMode Or .EntryPoint Then

but I much prefer to see

If .ShouldShowMessage Then

and to put that Boolean logic in the property

Public Property Get ShouldShowMessage() As Boolean

ShouldShowMessage = Me.DebugMode Or Me.EntryPoint

End Property

I get the benefit of using and reusing ShouldShowMessage wherever I want and if the logic changes, I change it only in one place. I only use it once and probably won’t use it anywhere else, but beyond that I just like that the intent is embedded in the code so the reader doesn’t have to try to figure it out unless they want to.

And here’s some fake code to see if it works.

Sub Main()

Dim lResp As Long

Const sSOURCE As String = "Main()"

On Error GoTo ErrorHandler

lResp = MsgBox("Cancel?", vbYesNo, gsAPPTITLE)
If lResp = vbYes Then
Err.Raise ErrorType.UserCancel, sSOURCE
Else
Sub_Procedure
End If

Exit Sub

ErrorHandler:
If HandleError(msMODULE, sSOURCE, , True) Then
Stop
Resume
End If

End Sub

Sub Sub_Procedure()

Dim i As Long

Const sSOURCE As String = "Sub_Procedure()"

On Error GoTo ErrorHandler

i = Sub_Function(1) 'no error here
i = Sub_Function(0) 'this will create a divide by zero

Exit Sub

ErrorHandler:
If HandleError(msMODULE, sSOURCE) Then
Stop
Resume
End If

End Sub

Function Sub_Function(lDenom As Long) As Long

Dim i As Long

Const sSOURCE As String = "Sub_Function()"

On Error GoTo ErrorHandler

i = 1 / lDenom 'When zero is passed in, an error is raised

Exit Function

ErrorHandler:
If HandleError(msMODULE, sSOURCE) Then
Stop
Resume
End If

End Function

Thanks to Bob Phillips for telling me to use an Enum instead of a constant: ErrorType.UserCancel vs. glUSERCANCEL.

You can download ErrorClass.zip

Leave a Reply

Your email address will not be published. Required fields are marked *