应用程序/错误处理

概要

以下代码模块显示了一种用于错误处理的布局方法。它使用的空间比平常多一些，但清晰度很高。它还包括错误日志记录和一个用于通过引发错误来测试代码的块。只列出了少数错误。

请注意，在日志写入过程中本身没有进行任何格式化，并且包含了带有行分隔的块日志或带有逗号分隔的串行日志的选择。

VBA 代码

Option Explicit

Sub ErrorCodeShell()
    'time saving errors code shell
   

On Error GoTo ERR_HANDLER
    
    '===================================
    'Main body of procedure goes here...
    '===================================
    
    '===================================
    '   Raise Errors Here For Testing
    '===================================
    'Err.Raise 6  'overflow
    Err.Raise 11 'div zero
    'Err.Raise 53 'file not found
    'Err.Raise 70 'permission denied
    '===================================
    
    Exit Sub
ERR_HANDLER:
    If Err.Number <> 0 Then
        'LOG ERROR DETAILS
        
        'make error messages
        Dim sE1 As String, sE2 As String
        Dim oErr1 As ErrObject, oErr2 As ErrObject
        
        'make error messages
        Set oErr1 = Err: Set oErr2 = Err
        sE1 = Message1(oErr1) 'block style message
        sE2 = Message2(oErr2) 'serial style
        Set oErr1 = Nothing: Set oErr2 = Nothing
                
        'enable logging as block or serial format
        LogError3 sE1   'write to log block style
        'LogError3 sE2   'write to log serial style
                
        'write to immediate window
        Debug.Print sE1 'block style
        'Debug.Print sE2 'serial style
        
        'selective error handling
        Select Case Err.Number
        Case 53
            GoTo FileNotFound
        Case 70
            GoTo PermissionDenied
        Case Else:
            GoTo OtherErrors
        End Select
FileNotFound:
        'Handle the error
        Err.Clear
        Exit Sub
PermissionDenied:
        'Handle the error
        Err.Clear
        Exit Sub
OtherErrors:
        MsgBox sE1
        Err.Clear
        Exit Sub
    End If

End Sub

Function LogError3(sIn As String) As Boolean
    'logs parameter string to a text file
    'assumes same path as calling Excel workbook
    'makes file if does not exist
    'no layout or formatting - assumes external
    
    Dim sPath As String, Number As Integer
    
    Number = FreeFile 'Get a file number
    sPath = ThisWorkbook.Path & "\error_log3.txt" 'modify path\name here
    
    Open sPath For Append As #Number
    Print #Number, sIn
    Close #Number

    LogError3 = True
            
End Function

Function Message1(oE As ErrObject) As String
    'makes block style message for error
    
    Dim sEN As String, sSrc As String
    Dim sDesc As String, sDT As String
    
    'make date-time string
    sDT = Format(Now, "d mmm yyyy") & ", " & _
                   Format(Now, "dddd hh:mm:ss AMPM")
    
    'get error parts
    sEN = CStr(oE.Number)   'number of error
    sSrc = oE.Source        'source of error
    sDesc = oE.Description  'description of error
    
    'make block message with line separations
    Message1 = sDT & vbNewLine & _
        "Error number: " & sEN & vbNewLine & _
        "Source: " & sSrc & vbNewLine & _
        "Description: " & sDesc & vbNewLine

End Function

Function Message2(oE As ErrObject) As String
    'makes serial style message for error
    
    Dim sEN As String, sSrc As String
    Dim sDesc As String, sDT As String
    
    'make date-time string
    sDT = Format(Now, "dddd yyyy mmm d hh:mm:ss")
    
    'get error parts
    sEN = CStr(oE.Number)   'number of error
    sSrc = oE.Source        'source of error
    sDesc = oE.Description  'description of error
    
    'make serial message with comma separations
    Message2 = sDT & ",Error " & sEN & "," & sSrc & "," & sDesc

End Function