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.
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.
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.
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.
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
but I much prefer to see
and to put that Boolean logic in the property
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.
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
