はじめに
クラスモジュールでチェックを行い、エラーの場合はErr.Raiseで独自のエラーを発生させるようにしていました。
呼び出し経路は以下の通りです。
- 標準モジュール
- シートモジュール
- クラスモジュール
この時、3で発生した例外が、1の標準モジュールで正しく捕捉できませんでした。
原因までは特定できていませんが、シートモジュールを経由してエラーが伝播すると、元のErr.Raiseで設定したエラーではなく、オートメーションエラーに置き換わることまでは確認できました。
発生したエラー
Excelには以下のような表があります。
これらのデータが書いてあるシートモジュールにFindAllメソッドを定義し、Employeeクラスのリストに変換します。
' EmployeeSheet
Function FindAll() As Collection
Dim lastRow As Long
Dim i As Long
Dim result As Collection
Set result = New Collection
lastRow = Me.Cells(Rows.Count, "A").End(xlUp).Row
Dim emp As Employee
For i = 2 To lastRow
Set emp = New Employee
' 変換部
emp.Id = Me.Cells.item(i, 1)
emp.Name = Me.Cells.item(i, 2)
emp.Department = Me.Cells.item(i, 3)
emp.ManagerId = Me.Cells.item(i, 4)
emp.Email = Me.Cells.item(i, 5)
emp.Active = Me.Cells.item(i, 6)
result.Add emp
Next i
Set FindAll = result
End Function
Employeeクラスは以下の通りです。
Option Explicit
Private mId As Long
Private mName As String
Private mDepartment As String
Private mManagerId As Variant
Private mEmail As String
Private mActive As Boolean
' その他のアクセサーメソッドは省略しています
Public Property Let Department(ByVal value As String)
If value = "" Then
' 例外発生
Err.Raise vbObjectError + 513, "Employee.LetDepartment", "値が空欄です。"
End If
mDepartment = value
End Property
上記Excelデータの黄色セルではdepartment列を空欄に設定しているため、EmployeeクラスのLet Departmentメソッドで例外が発生します。
標準モジュールではこの例外を捕捉するように、On Error Go Toを利用しています。
Sub Main_Error()
On Error GoTo ErrHandler
Dim result As Collection
Set result = EmployeeSheet_Error.FindAll()
Dim item As Employee
For Each item In result
Debug.Print item.Name
Next item
Exit Sub
ErrHandler:
' 例外を捕捉
MsgBox Err.Description, vbCritical
End Sub
この時、例外を捕捉し独誌のエラーメッセージ「値が空欄です。」が表示される想定でしたが、以下のメッセージが表示されました。
オートメーションエラーです。
イベントはどのサブスクライバーも呼び出すことができませんでした
回避方法
シートモジュールを経由するのをやめました。
ですので、標準モジュールに以下全てを書くようにしました。
Sub Main_Solution()
On Error GoTo ErrHandler
Dim result As Collection
' 標準モジュールのFindAllを呼び出す。
Set result = FindAll()
Dim item As Employee
For Each item In result
Debug.Print item.Name
Next item
Exit Sub
ErrHandler:
MsgBox Err.Description, vbCritical
End Sub
Function FindAll() As Collection
Dim lastRow As Long
Dim i As Long
Dim result As Collection
Set result = New Collection
lastRow = EmployeeSheet.Cells(Rows.Count, "A").End(xlUp).Row
Dim emp As Employee
For i = 2 To lastRow
Set emp = New Employee
emp.Id = EmployeeSheet.Cells.item(i, 1)
emp.Name = EmployeeSheet.Cells.item(i, 2)
emp.Department = EmployeeSheet.Cells.item(i, 3)
emp.ManagerId = EmployeeSheet.Cells.item(i, 4)
emp.Email = EmployeeSheet.Cells.item(i, 5)
emp.Active = EmployeeSheet.Cells.item(i, 6)
result.Add emp
Next i
Set FindAll = result
End Function
シートモジュールを経由しないと正しいメッセージが表示されました。
実行環境
Microsoft 365 Apps for business
まとめ
なんだか、納得性の低い解決法になってしまいました。
シートモジュールに書きつつ、解決する方法ももしかしたらあるのかもしれません。
ちなみにサンプルでは1つの標準モジュールに書いてしまっていますが、実際にはEmployeeRepositoryという標準モジュールを作成してそこに記載しています。よく考えるとシートモジュールに書くより、分かりやすいのかもしれません。
何か知見のあるかたおりましたら、コメントしていただけると幸いです。