I've been reusing an error class in Excel VBA projects for a few years now and I'd like to see if there are ways to improve it. Any suggestions for style, code, etc. are all welcome.
The 2 procedures I'd like to focus on are:
Error_Handler.DisplayMessage
Error_Handler.Log
The log file is usually written to a file server so multiple users can access it. I have changed the log path to C:\Temp\
for this example. I use BareTail to read the log file.
I use Custom Document Properties to store settings for the file/Add-in
An example of a project I use the Error Handler class and logging in is on GitHub. For reference, I am using Excel 2016 on Windows 7.
Error_Handler Class
Attribute VB_Name = "Error_Handler"
'====================================================================================================================
' Purpose: Error trapping class
'====================================================================================================================
Option Explicit
Public App As MyAppInfo
Public Type MyAppInfo
Name As String
ReleaseDate As Date
Version As String
End Type
Private Const MyModule As String = "Error_Handler"
Public Sub Load()
On Error GoTo ErrTrap
App.Name = ThisWorkbook.CustomDocumentProperties("App_Name").Value
App.ReleaseDate = ThisWorkbook.CustomDocumentProperties("App_ReleaseDate").Value
App.Version = ThisWorkbook.CustomDocumentProperties("App_Version").Value
ExitProcedure:
On Error Resume Next
Exit Sub
ErrTrap:
Select Case Err.number
Case Is <> 0
Error_Handler.DisplayMessage "Load", MyModule, Err.number, Err.description
Resume ExitProcedure
Case Else
Resume ExitProcedure
End Select
End Sub
Public Sub DisplayMessage( _
ByVal procedure As String _
, ByVal module As String _
, ByVal number As Double _
, ByVal description As String _
, Optional ByVal line As Variant = 0 _
, Optional ByVal title As String = "Unexpected Error" _
, Optional ByVal createLog As Boolean = True)
'====================================================================================================================
' Purpose: Global error message for all procedures
' Example: Error_Handler.DisplayMessage "Assembly_Info", "Load", 404, "Error Message Here...", 1, "Error Description"
'====================================================================================================================
On Error Resume Next
Dim msg As String
msg = "Contact your system administrator."
msg = msg & vbCrLf & "Module: " & module
msg = msg & vbCrLf & "Procedure: " & procedure
msg = msg & IIf(line = 0, "", vbCrLf & "Error Line: " & line)
msg = msg & vbCrLf & "Error #: " & number
msg = msg & vbCrLf & "Error Description: " & description
If createLog Then
Log module, procedure, number, description
End If
MsgBox msg, vbCritical, title
End Sub
Public Sub Log( _
ByVal module As String _
, ByVal procedure As String _
, ByVal number As Variant _
, ByVal description As String)
'====================================================================================================================
' Purpose: Creates a log file and record of the error
' Example: Error_Handler.Log "Assembly_Info", "Load", "404", "Error Message Here..."
'====================================================================================================================
On Error GoTo ErrTrap
Dim fileSizeMax As Double: fileSizeMax = 1024 ^ 2 'archive the file over 1mb
Dim AppName As String: AppName = LCase(Replace(App.Name, " ", "_"))
Dim fileName As String: fileName = "C:\temp\excel_addin." & AppName & ".log"
Dim fileNumber As Variant: fileNumber = FreeFile
Const dateFormat As String = "yyyy.mm.dd_hh.nn.ss"
If Dir(fileName) <> "" Then
If FileLen(fileName) > fileSizeMax Then 'archive the file when it's too big
FileCopy fileName, Replace(fileName, ".log", Format(Now, "_" & dateFormat & ".log"))
Kill fileName
End If
End If
Open fileName For Append As #fileNumber
Print #fileNumber, CStr(Format(Now, dateFormat)) & _
"," & Environ("UserName") & _
"," & Environ("ComputerName") & _
"," & Application.OperatingSystem & _
"," & Application.Version & _
"," & App.Version & _
"," & Format(App.ReleaseDate, "yyyy.mm.dd_hh.nn.ss") & _
"," & ThisWorkbook.FullName & _
"," & module & _
"," & procedure & _
"," & number & _
"," & description
ExitProcedure:
On Error Resume Next
Close #fileNumber
Exit Sub
ErrTrap:
Select Case Err.number
Case Is <> 0
Debug.Print "Module: " & module & " |Procedure: " & procedure & " |Error #: " & number & " |Error Description: " & description
Resume ExitProcedure
Case Else
Resume ExitProcedure
End Select
End Sub
Usage Example:
Public Function GetItem(ByVal col As Variant, ByVal key As Variant) As Variant
On Error GoTo ErrTrap
Set GetItem = col(key)
ExitProcedure:
On Error Resume Next
Exit Function
ErrTrap:
Select Case Err.number
Case Is = 9 'subscript out of range = this column does not exist in the active table
Set GetItem = Nothing
Resume ExitProcedure
Case Is <> 0
Error_Handler.DisplayMessage "GetItem", "Example_Module", Err.number, Err.description
Set GetItem = Nothing
Resume ExitProcedure
Case Else
Resume ExitProcedure
End Select
End Function