CodeItBetter Programming Another VB Programming Blog

'Error Handling - Class to handle errors in vb with loggin option to log the errors at a specific location
Option Explicit
 
'This code is a class to handle errors in visual basic very easily.  It even 
'has a logging option to log the errors to a specified location.  is compatible
'with ADO and RDO, even logs the errors collection.

' API Function to get the user name
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
    (ByVal v_strBuffer As String, ByRef r_lngSize As Long) As Long
 
' API Function to get the computer name
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" _
    (ByVal v_strBuffer As String, ByRef r_lngSize As Long) As Long
 
Const mc_lngSize As Long = 255       ' used when retrieveing the user and computer names
Const mc_strEmpty As String = ""     ' used to check for empty strings

Private m_strFilePath As String      ' path to save the log
Private m_blnLoggingOn As Boolean    ' turn logging on or off
Private m_strUserName As String      ' store the user name for logging purposes
Private m_strComputerName As String  ' the name of the computer the error occurred on
Private m_objErrADO As Object        ' object used to store the ADO Errors collection
Private m_objErrRDO As Object        ' object used to store the RDO Errors collection

Public Property Let blnLoggingOn(ByVal v_blnLoggingOn As Boolean)
    m_blnLoggingOn = v_blnLoggingOn
End Property
 
Private Sub Class_Initialize()
    ' PURPOSE: sets the defaults of the log file path and user name.  The computer 
    '          name is not an option.
    ' ASSUMES: log file path and user name are defaulted
    Const c_strLogFileName As String = "\ErrorLog.txt"
    m_strFilePath = App.Path & c_strLogFileName
    m_strUserName = strWindowsLogon()
    m_strComputerName = strComputerName()
End Sub
 
Private Sub Class_Terminate()
    ' PURPOSE: To clear all varibles
    m_strFilePath = mc_strEmpty
    m_strUserName = mc_strEmpty
    m_strComputerName = mc_strEmpty
End Sub
 
Private Sub m_CheckErrors(ByVal v_objError As VBA.ErrObject, ByVal v_strReportedBy As String)
    ' PURPOSE: To check all the Error Objects and log them to a file
    Dim objItem As Object
    Call m_LogError(v_objError, v_strReportedBy)    ' log the initial error
    ' Check the value of m_objErrADO to see if it has been set or not
    If Not m_objErrADO Is Nothing Then
        For Each objItem In m_objErrADO
            Call m_LogError(objItem, v_strReportedBy)
        Next
    End If
    ' Check the value of m_objErrRDO to see if it has been set or not
    If Not m_objErrRDO Is Nothing Then
        For Each objItem In m_objErrRDO
            Call m_LogError(objItem, v_strReportedBy)
        Next
    End If
End Sub
 
Private Sub m_LogError(ByVal v_objError As Object, ByVal v_strReportedBy As String)
    ' PURPOSE: Writes the error to a log file the user specifies or the application folder
    ' INPUTS : v_objError - the current error that has occurred
    '          v_strReportedBy - what procedure reported the error
    Const c_strDelimiter As String = vbTab
    Dim intLogFile As Integer
    If CLng(v_objError.Number) <> 0 Then
        intLogFile = FreeFile
        Open m_strFilePath For Append Access Write As intLogFile
        ' Write the error to the file
        Print #intLogFile, , CStr(Format(Now(), "mm/dd/yyyy hh:nn:ss")) & c_strDelimiter & _
            App.EXEName & c_strDelimiter & _
        v_objError.Number & c_strDelimiter & v_strReportedBy & c_strDelimiter & _
            v_objError.Source & c_strDelimiter & v_objError.Description & c_strDelimiter & _
            m_strUserName & c_strDelimiter & m_strComputerName
        Close #intLogFile
    End If
End Sub
 
Private Function m_strMakeCallPath(ByVal v_strProcSig As String, _
    ByVal v_strErrorSource As String) As String
    ' PURPOSE: To create the path of the error as it is bubbled up the call stack
    ' INPUTS : v_strProcSig - the name of the procedure where the error is raised
    '          v_strErrorSource - the name of the error source
    ' RETURNS: The call path of the error
    Const c_strCallPathSeparator As String = " | "
    m_strMakeCallPath = v_strProcSig & c_strCallPathSeparator & v_strErrorSource
End Function
 
Public Property Set objErrorsADO(ByVal v_objErrors As Object)
    Set m_objErrADO = v_objErrors
End Property
 
Public Property Set objErrorsRDO(ByVal v_objErrors As Object)
    Set m_objErrRDO = v_objErrors
End Property
 
Public Sub RaiseError(ByVal v_objErr As VBA.ErrObject, ByVal v_strProcSig As String)
    ' PURPOSE: allows the user to raise an error when there is no error handling routine in the
    '          procedure from which this procedure was called
    ' INPUTS : v_objError - the object that holds the current error information
    '          v_strProcSig - name of the procedure where the error occurred
    v_objErr.Raise v_objErr.Number, m_strMakeCallPath(v_strProcSig, v_objErr.Source), _
        v_objErr.Description
End Sub
 
Public Sub ShowError(ByVal v_objError As VBA.ErrObject, ByVal v_strReportedBy As String)
    ' PURPOSE: Displays the error to the user and if logging is turned on, it logs the error to
    '          a file
    ' INPUTS : v_objError - the object that holds the current error information
    '          v_strReportedBy - what procedure reported the error
    Call MsgBox("Error: " & v_objError.Number & vbCrLf & "Reported By: " & v_strReportedBy & _
        vbCrLf & "Source: " & v_objError.Source & vbCrLf & "Description: " & _
        v_objError.Description, vbInformation, "Error")
    If m_blnLoggingOn Then Call m_CheckErrors(v_objError, v_strReportedBy)
End Sub
 
Public Function strComputerName() As String
    ' PURPOSE: will get the computer name
    ' INPUTS : None
    ' ASSUMES: None
    ' RETURNS: the computer name
    ' EFFECTS: None
    Dim strString As String
    Dim lngSize As Long
    Dim lngComputerName As Long
    strString = String$(mc_lngSize, vbNullChar)
    lngSize = mc_lngSize
    lngComputerName = GetComputerName(strString, lngSize)
    strComputerName = Left$(strString, lngSize)
End Function
 
Public Property Let strLogPath(ByVal v_strPath As String)
    If v_strPath <> mc_strEmpty Then m_strFilePath = v_strPath
End Property
 
Public Property Let strUserName(ByVal v_strUser As String)
    m_strUserName = v_strUser
End Property
 
Public Function strWindowsLogon() As String
    ' PURPOSE: will get the Windows logon id
    ' INPUTS : None
    ' ASSUMES: None
    ' RETURNS: the Windows logon id
    ' EFFECTS: None
    Dim lngUserName As Long
    Dim strString As String
    Dim lngSize As Long
 
    strString = String$(mc_lngSize, vbNullChar)
    lngSize = mc_lngSize
    lngUserName = GetUserName(strString, lngSize)
    strWindowsLogon = Left$(strString, lngSize - 1)
End Function