Errオブジェクトをラップしたクラス

akashi-keirin.hatenablog.com

このとき、ErrObjectクラスはインスタンス化できないことを示した。

よく「Errオブジェクト」という表現も見かけるが、

Set hoge = New Err

という書き方ができるわけでもない。

ただ、イミディエイト・ウインドウで

?TypeName(Err)

と書いて[Enter]を押すと、ErrObjectが返る。

……ということは、よく使うErrというやつは、ErrObjectクラスの唯一のインスタンスなのか……？？？

この辺はよくわからん。

とにかく、エラーが出たときに、そのエラーそのものを外に投げられたらいいのに、と思ったので、Errオブジェクトをラップしたクラスを作ってみた。

ErrorObjectクラス

「Error」も「ErrObject」も既に使われているオブジェクト名なので、オブジェクト名は「ErrorObject」にした。うーん、イマイチ。

ちなみに、Attribute VB_PredeclaredId = Trueにしている。

クラスモジュール　ErrorObject

Option Explicit

'///Attribute VB_PredeclaredId = True///'

Private number_ As Long
Private description_ As String
Private lastDllError_ As Long
Private source_ As String

Public Property Get Number() As Long
  Number = number_
End Property
Public Property Let Number(ByVal value_ As Long)
  number_ = value_
End Property

Public Property Get Description() As String
  Description = description_
End Property
Public Property Let Description(ByVal value_ As String)
  description_ = value_
End Property

Public Property Get LastDllError() As Long
  LastDllError = lastDllError_
End Property
Public Property Let LastDllError(ByVal value_ As Long)
  lastDllError_ = value_
End Property

Public Property Get Source() As String
  Source = source_
End Property
Public Property Let Source(ByVal value_ As String)
  source_ = value_
End Property

Public Sub clearError()
  number_ = 0
  description_ = ""
  lastDllError_ = 0
  source_ = ""
  Call Err.Clear
End Sub
Public Sub raiseError( _
             Optional ByVal number__ As Long, _
             Optional ByVal source__ As Long, _
             Optional ByVal description__ As String)
  If number__ > 0 Then number_ = number__
  If source__ > 0 Then source_ = source__
  If description__ <> "" Then description_ = description__
  If number_ = 0 Then Exit Sub
  Call Err.Raise(number_, source_, description_)
End Sub

Public Function getInstance( _
                  ByVal number__ As Long, _
         Optional ByVal description__ As String, _
         Optional ByVal source__ As String, _
         Optional ByVal lastDllError__ As Long) As ErrorObject
  Dim ret As New ErrorObject
  ret.Number = number__
  ret.Description = description__
  ret.Source = source__
  ret.LastDllError = lastDllError__
  Set getInstance = ret
End Function

ホントにただErrオブジェクトをラップしただけ。getInstanceメソッドでインスタンスを吐くようにしたけれど、意味があるのかどうなのかわからない。

使ってみる

標準モジュールに次のようなコードを書いて実験。

リスト１　標準モジュール

Option Explicit

Private ret As ErrorObject
Private errorSource As String

Public Sub test()
  Dim result As ErrorObject
  Set result = aCertainProcess
  With result
    Debug.Print "Number:" & .Number
    Debug.Print "Description:" & .Description
    Debug.Print "Source:" & .Source
    Debug.Print "LastDLLError:" & .LastDllError
  End With
End Sub

Private Function aCertainProcess() As ErrorObject
  On Error Resume Next
  Call process1
  If Err.Number > 0 Then _
    errorSource = "手順１": GoTo ErrorHandler
  Call process2
  If Err.Number > 0 Then _
    errorSource = "手順２": GoTo ErrorHandler
  Call process3
  If Err.Number > 0 Then _
    errorSource = "手順３": GoTo ErrorHandler
ErrorHandler:
  Set ret = ErrorObject.getInstance( _
              Err.Number, Err.Description, errorSource, Err.LastDllError)
  Call Err.Clear
  Set aCertainProcess = ret
  Set ret = Nothing
End Function

Private Sub process1()
  
End Sub

Private Sub process2()
  
End Sub

Private Sub process3()
  Call Err.Raise(5)
End Sub

aCertainProcessメソッドの返り値をErrorObject型にしている。

aCertainProcessからは、process1、process2、process3の各メソッドを呼び出す。process1、process2では何も起きないが、process3メソッドを実行すると、エラー番号「5」の実行時エラーが起きる。

aCertainProcessメソッドでは、process1、process2、process3の各メソッドを実行するごとにErr.Numberプロパティを調べ、「0」を超える数値が返ったら、すなわちエラーが起きていたら、変数errorSourceに処理の場所を表す文字列をセットして、ErrorHandlerラベルに飛ぶ。

ErrorHandlerラベル以下では、そのときのErrオブジェクトの状態を転写したErrorObjectクラスのインスタンスを作成してreturn。

呼び出し元のtestプロシージャでは、返り値であるErrorObjectクラスのインスタンスが持っている諸データをイミディエイトに出力する。