VBA で Try～Catch～Finally を実装する

例として「Sheet1の表から都道府県が東京都のデータをSQLでSheet2に抽出するマクロ」に Try～Catch～Finally を実装してみよう。
VBA には Try～Catch～Finally がないので GoTo文で代用する。

ポイントは、

• エラーがあってもなくても Finally は実行する
• オブジェクトの Close と参照の開放は Finally でまとめて行う

上記に留意すればとくに難しい部分はない。

Sub TryCatchFinally()

On Error GoTo ErrCatch

    Dim errNum As Long

    Dim cn As Object
    Dim rs As Object
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")

    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .Properties("Extended Properties") = "Excel 12.0;HDR=YES;IMEX=1"
        .Open ThisWorkbook.FullName
    End With

    With rs
        .CursorLocation = 3
        .Open "SELECT * FROM [" & Sheet1.Name & "$] WHERE 都道府県='東京都';", cn
    End With

    With Sheet2
        .Rows("2:" & .Rows.Count).ClearContents
        .Range("A2").CopyFromRecordset rs
        .Columns.AutoFit
    End With

    GoTo Finally  '-- これを忘れないように

ErrCatch:

    errNum = DebugPrintError(Err, "TryCatchFinally")
    Resume Finally
    
Finally:

    Call CloseADO(rs, cn)
    Call SetNothing(rs, cn)
    Call EndOnError(errNum)

End Sub

'// エラー情報を出力してエラー番号を返す

Function DebugPrintError(e_r_r As ErrObject, ByVal err_point As String) As Long

    '--［err_point］エラーCatchしたプロシージャ名

    Dim errNum As Long: errNum = e_r_r.Number

    If errNum <> 0 Then
        Debug.Print "エラー箇所："; err_point
        Debug.Print "エラー内容："; e_r_r.Description
        Debug.Print "エラー番号："; e_r_r.Number
        Debug.Print "エラーソース："; e_r_r.Source
    End If
    e_r_r.Clear

    DebugPrintError = errNum

End Function

'// 引数で与えられたすべてのADOオブジェクト（ado）を閉じる

Sub CloseADO(ParamArray ado())

    Dim adStateOpen As Long: adStateOpen = 1

    Dim i As Long
    For i = LBound(ado) To UBound(ado)
        If ado(i).State = adStateOpen Then ado(i).Close
    Next i

End Sub

'// 引数で与えられたすべてのオブジェクト（obj）への参照を解放する

Sub SetNothing(ParamArray obj())

    Dim i As Long
    For i = LBound(obj) To UBound(obj)
        If Not obj(i) Is Nothing Then Set obj(i) = Nothing
    Next i

End Sub

'// エラーが発生した場合はマクロを終了する

Sub EndOnError(ByVal errNum As Long)

    If errNum <> 0 Then
        MsgBox "エラーが発生したのでプログラムを停止します。", vbExclamation
        End
    End If

End Sub

このままだとエラーが発生しないので、エラーを発生させたい場合は、例えば、

　"SELECT * FROM [" & Sheet1.Name & "$] WHERE 都道府県='東京都';"

の部分の WHERE と 都道府県 の間のスペースを削除して、

　"SELECT * FROM [" & Sheet1.Name & "$] WHERE都道府県='東京都';"

にするとエラーが発生する。