My VBA global error handler > *.VBA global error handlers

Discussion in 'OT Technology' started by Black Light, Nov 2, 2004.

  1. Black Light

    Black Light Guest

    Actual error handler module:
    Code:
    Option Compare Database
    Option Explicit
    
    Public Enum ProcTypes
        aFunction = 1
             aSub = 2
    End Enum
    
    Private Type ProcId
        ProcType As ProcTypes
        ProcName As String
        ModuleName As String
    End Type
    
    Public gPID As ProcId
    
    '<*******************************************
    ' Global error handler function
    '<===========================================
    ' Inputs
    '===========================================>
    '    Err --> error object
    '<===========================================
    ' Usage
    '===========================================>
    ' Full:
    '<------------
    '    With gPID
    '        .ModuleName = "modPadStrings"
    '        .ProcName = "PadStr"
    '        .ProcType = aFunction
    '    End With
    '    If ErrNotify(Err, True) Then Resume Next
    '------------>
    ' Simplified:
    '------------
    '    If ErrNotify(Err) Then Resume Next
    '*******************************************>
    Public Function ErrNotify( _
        nErr As ErrObject, _
        Optional IdExists As Boolean = False) As Boolean
                    
        Dim gAnswer As Integer
        Dim sTitle As String
        Dim sMsg(4) As String
        Dim nBtns As Long
        Const sLine As String = vbCrLf & vbCrLf
        
        nBtns = vbExclamation + vbYesNo + vbDefaultButton1
        sTitle = "Error #" & _
                nErr.Number & " in " & _
                nErr.Source
        
        sMsg(1) = "System identified error is: " & vbCrLf & _
            nErr.Description
                
        If IdExists Then
            sMsg(2) = sLine & _
                "Error source identified itself as:" & vbCrLf & _
                PadStr("Module Name: ", 20, , , True) & gPID.ModuleName
                
            Select Case gPID.ProcType
            Case aFunction
                sMsg(3) = "Function"
            Case aSub
                sMsg(3) = "Sub"
            End Select
                
            sMsg(1) = sMsg(1) & sMsg(2) & vbCrLf & _
                PadStr("Procedure Type: ", 20, , , True) & sMsg(3) & vbCrLf & _
                PadStr("Procedure Name: ", 20, , , True) & gPID.ProcName & sLine
        End If
        
        gAnswer = MsgBox(sMsg(1) & "Continue?", nBtns, sTitle)
        ErrNotify = (gAnswer = vbYes)
        
    End Function
    String padder:
    Code:
    Option Compare Database
    Option Explicit
    
    Dim strPad As String
    
    Public Function PadStr(Str2Pad As String, _
            Optional PadChrCount As Integer = 5, _
            Optional DoTrunc As Boolean = False, _
            Optional PadLeft As Boolean = False, _
            Optional PadRight As Boolean = False, _
            Optional MySpace As String = " ") As String
            
        On Error GoTo PadStr_Error
            
        If PadChrCount <= Len(Str2Pad) Then
            If DoTrunc Then
                PadStr = Left$(Str2Pad, PadChrCount)
            Else
                PadStr = Str2Pad
            End If
            Exit Function
        End If
        
        If PadChrCount - Len(Str2Pad) < 1 Then
            strPad = ""
        Else
            strPad = String(PadChrCount - Len(Str2Pad), MySpace)
        End If
        
        PadStr = Str2Pad
        If PadLeft Then PadStr = strPad & PadStr
        If PadRight Then PadStr = PadStr & strPad
        
        Debug.Print PadStr & " = " & Len(PadStr)
    PadStr_Exit:
        Exit Function
        
    PadStr_Error:
        With gPID
            .ModuleName = "modPadStrings"
            .ProcName = "PadStr"
            .ProcType = aFunction
        End With
    
        If ErrNotify(Err, True) Then Resume Next
        
    End Function
    
    :embd:

    *EDIT*

    :doh:
     
    Last edited by a moderator: Nov 2, 2004
  2. Black Light

    Black Light Guest

    comments? :hsugh:
     
  3. samm

    samm Next in Line

    Joined:
    Dec 22, 2000
    Messages:
    2,630
    Likes Received:
    0
    Location:
    San Jose, CA
    I don't know VB or VBA or whatever flavor Microsoft is promoting this month. What does this code do?
     
  4. Penguin Man

    Penguin Man Protect Your Digital Liberties

    Joined:
    Apr 27, 2002
    Messages:
    21,696
    Likes Received:
    0
    Location:
    Edmonton, AB
    VB :hsugh:
     
  5. Black Light

    Black Light Guest

    Automatically handles errors :o
     
  6. Black Light

    Black Light Guest

    :squint: :fawk: :o
     

Share This Page