cerrors.cls

来自「Decision 算法」· CLS 代码 · 共 90 行

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cErrors"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Private mvarErrorObject As ErrObject
Private mvarErrorSource As String
Private mvarErrorDisplay As VbMsgBoxStyle
Private mvarOnErrorAction As String

Public Property Get OnErrorAction() As String
    OnErrorAction = mvarOnErrorAction
End Property

Public Property Get ErrorDisplay() As VbMsgBoxStyle
    ErrorDisplay = mvarErrorDisplay
End Property

Public Property Get ErrorSource() As String
    ErrorSource = mvarErrorSource
End Property

Public Function ErrorHandler(errErrorObject As ErrObject, _
                            Optional strErrorSource As String, _
                            Optional vbMessageType As VbMsgBoxStyle, _
                            Optional strOnErrorAction As String) _
                        As cErrors
                        
                        
    Dim strMsg As String
    
    
    'The error object
    Set mvarErrorObject = errErrorObject
    
    'The object where the error occured
    If strErrorSource <> "" Then
        mvarErrorSource = strErrorSource
    End If
    
    'The type of message to display
    'e.g. informational, warning
    If vbMessageType <> 0 Then
        mvarErrorDisplay = vbMessageType
    End If
    
    'The type of action to take when an error occurs
    'E.g. log the error, display a message box
    If strOnErrorAction <> "" Then
            mvarOnErrorAction = strOnErrorAction
    End If
    
    
    With mvarErrorObject
        
        If strOnErrorAction = "" Then
            strMsg = "An error has occured!"
            strMsg = strMsg & vbCrLf
            strMsg = strMsg & "Error Number : " & .Number
            strMsg = strMsg & vbCrLf
            strMsg = strMsg & "Error Description : " & .Description
            strMsg = strMsg & vbCrLf
            strMsg = strMsg & "Error Source : " & .Source
        End If
            
    End With
    
    
    If strOnErrorAction = "" Then
        MsgBox strMsg, vbMessageType, "ParetoAnalyzer" & "." & strErrorSource
    End If
    

End Function

Public Property Get ErrorObject() As ErrObject
    Set ErrorObject = mvarErrorObject
End Property