終了処理の確認

まず、VBAのIDE(編集画面)を開いて「標準モジュール」を追加し、以下のコードを記述してみます。

Dim m_Coll As Collection

Public Sub TestSub1()
    Set m_Coll = New Collection
End Sub

Public Sub TestSub2()
    If m_Coll Is Nothing Then
        Debug.Print "m_Coll is Nothing"
    Else
        Debug.Print "m_Coll is not Nothing"
    End If
End Sub

記述してすぐに「TestSub2」を実行すると、イミディエイトウィンドウには「m_Coll is Nothing」が出力されますが、一度「TestSub1」を実行してから「TestSub2」を実行すると「m_Coll is not Nothing」が出力されます。さらに、もう一度「TestSub2」を実行してもやはり「m_Coll is not Nothing」が出力されます。この状態で「リセット」コマンド(IDE上の停止マークのコマンド)を実行し、再び「TestSub2」を実行すると「m_Coll is Nothing」となり、変数 m_Coll が破棄されているのが分かります。すなわち、VBA処理が終了するタイミングでは必ずオブジェクト変数を破棄する処理が行われているということになります。

IUnknown::Release とオブジェクト

ここで、m_Coll は「Collection」型(クラス)なのですが、Collection 型はCOMのクラスに基づいて作られたものです。COMではすべてのクラスが IUnknown インターフェイスを基本としており、インスタンスを作成(New での作成に相当)したものは必ず IUnknown::Release メソッドを呼び出して破棄しなければならないため、Collection 型の変数の破棄もやはり IUnknown::Release メソッドを呼び出していることになります。

※ 同じインスタンスを使いまわす場合は、原則としてその数だけ IUnknown::AddRef メソッドを呼び出し、使い終わったタイミングで IUnknown::Release メソッドを呼び出します。この際、内部では「参照カウンター」などの方式で AddRef/Release の呼び出し回数を管理し、カウンターが0になったタイミング(またはそれに相当するタイミング)でインスタンスの破棄を行います。これにより、ある箇所で使用中である場合に他の場所で IUnknown::Release の呼び出しが発生して破棄されてしまうことを防いでいます。

IUnknown::Release によって破棄が行われるタイミングについては、「クラス モジュール」を追加して Class_Terminate プロシージャを定義し、以下のようにコードを記述することで確認できます。(以下では追加したクラスを「MyClass1」という名前に変更しています。)

[クラスモジュール MyClass1]

Private Sub Class_Initialize()
    Debug.Print "MyClass1 initialized"
End Sub

Private Sub Class_Terminate()
    Debug.Print "MyClass1 terminated"
End Sub

[標準モジュール]

Dim m_obj As MyClass1

Public Sub TestClassSub1()
    Set m_obj = New MyClass1
End Sub

Public Sub TestClassSub2()
    Set m_obj = Nothing
End Sub

Public Sub TestClassSub3()
    If m_obj Is Nothing Then
        Debug.Print "m_obj is Nothing"
    Else
        Debug.Print "m_obj is not Nothing"
    End If
End Sub

このコードを記述後「TestClassSub1」を実行すると、MyClass1 のインスタンスが作られるため MyClass1 の Class_Initialize プロシージャが実行され、イミディエイトウィンドウに「MyClass1 initialized」が出力されます。Collection の場合と同様、この状態で「TestClassSub3」を実行すると「m_obj is not Nothing」が出力されます。また、ここで「TestClassSub2」を実行すると、MyClass1 のインスタンスがすべて使用されなくなったため MyClass1 の Class_Terminate プロシージャが実行され、「MyClass1 is terminated」が出力されます。このタイミングが IUnknown::Release の実行タイミングとなります。

ところが、理由は不明ですが、TestClassSub1 実行後にリセットコマンドを実行すると MyClass1 の Class_Terminate プロシージャは実行されません。実行はされないものの、リセット後に TestClassSub3 を実行すると m_obj は Nothing になっており、MyClass1 のインスタンスは破棄されていることが分かります。

そこで、実行されているはずの IUnknown::Release によるインスタンス破棄処理をVBAで行うための方法を次の項で紹介します。

自前 IUnknown インスタンスの作成

※ ここからはVBAでメモリブロックを扱う処理を紹介しています。記述を間違えるとアクセス違反によりVBAを持つアプリケーションが異常終了する可能性があるため、プログラムの実行前にファイルに保存するなどしてデータが失われないようにご注意ください。

「vftableについて」のページで少し紹介していますが、IUnknown インターフェイスは「IUnknownVtbl」のような形によってC言語で定義することができます。そのため、メモリブロックをうまく扱うことでVBAで自前の IUnknown インスタンスを作ることができます。

今回は最低限のデータを用いて IUnknown のインスタンスを作成してみます。簡単のため、メモリ配置は以下のようにします。

※ オフセット +08h (32ビット版) / +10h (64ビット版) からのデータを仮想関数テーブルとして使用します。
※ 64ビット版では LongPtr のサイズは 8 になります。仮想関数テーブルのアドレスを 8 の倍数にするため、RefCount データの直後に Padding データを入れています。

これをVBAで表現すると以下のようになります。なお、扱いやすくするために実際のインスタンスのデータと仮想関数テーブルを分けて定義します。

' インスタンスのデータ
Private Type MyClassData
    vtblPtr As LongPtr
    RefCount As Long
#If Win64 Then ' 64ビット版かどうか
    Padding As Long
#End If
End Type

' 仮想関数テーブルのデータ
Private Type IUnknownVtbl
    QueryInterface As LongPtr
    AddRef As LongPtr
    Release As LongPtr
End Type

※ VBA 7.0 未満(Office 2010 より前)である場合は「LongPtr」を「Long」に置き換えてください。VBA 7.0 以降の場合は32ビット版・64ビット版ともに上記のコードが利用できます。

また、インスタンス用のメモリブロックを自前で作るため、Win32APIのメモリ割り当て関数を利用します。割り当てるサイズが小さく、読み書きさえできればよいので、今回は CoTaskMemAlloc / CoTaskMemFree 関数を利用します。

Private Declare PtrSafe Function CoTaskMemAlloc Lib "ole32.dll" (ByVal cb As LongPtr) As LongPtr
Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As LongPtr)
Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
    (ByRef Destination As Any, ByRef Source As Any, ByVal Length As LongPtr)

' 変数に関数アドレスを代入するために用いる関数
Private Function GetAddressOf(ByVal func As LongPtr) As LongPtr
    GetAddressOf = func
End Function

' MyClassData と IUnknownVtbl のサイズを合わせたデータを指すポインターを返す
Private Function CreateInstanceMemory() As LongPtr
    Dim p As LongPtr, d As MyClassData, v As IUnknownVtbl
    ' MyClassData と IUnknownVtbl のサイズを合わせたデータを作成
    p = CoTaskMemAlloc(Len(d) + Len(v))
    If p <> 0 Then
        ' 最初の参照カウントは必ず 1 とする
        d.RefCount = 1
        ' MyClassData の直後に IUnknownVtbl を置くので p に MyClassData のサイズを加えたアドレスをセットする
        d.vtblPtr = p + Len(d)
        ' 割り当てたメモリブロックの先頭を MyClassData のデータで埋める
        Call CopyMemory(ByVal p, d, Len(d))
        ' 仮想関数テーブルの作成(My_ で始まる関数は後述)
        v.QueryInterface = GetAddressOf(AddressOf My_QueryInterface)
        v.AddRef = GetAddressOf(AddressOf My_AddRef)
        v.Release = GetAddressOf(AddressOf My_Release)
        ' 仮想関数テーブルを p + Len(d) の部分にコピー
        Call CopyMemory(ByVal d.vtblPtr, v, Len(v))
    End If
    CreateInstanceMemory = p
End Function

仮想関数テーブルを作成するため、IUnknown インターフェイスで必要なメソッド「QueryInterface」「AddRef」「Release」を実装します。

※ インスタンスのメソッドは必ず第1引数が「this」ポインターとなります。(32ビット版では __stdcall 呼び出し規約によりこれが保証されます。)

Private Type IID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Const S_OK As Long = 0
Private Const E_NOINTERFACE As Long = &H80004002
Private Const E_POINTER As Long = &H80004003

' HRESULT STDMETHODCALLTYPE QueryInterface(THIS_ REFIID refiid, LPVOID FAR* ppv)
' 別のインターフェイスへ変換するのをリクエストするときに呼び出される関数
' (ppv は念のため NULL チェックを入れるため ByVal で定義)
Private Function My_QueryInterface(ByVal This As LongPtr, ByRef refiid As IID, ByVal ppv As LongPtr) As Long
    Debug.Print "My_QueryInterface"
    If ppv = 0 Then
        Debug.Print "  E_POINTER"
        My_QueryInterface = E_POINTER
        Exit Function
    End If
    ' IID_IUnknown: {00000000-0000-0000-C000-000000000046} かどうか確認
    ' (2016/06/06 更新: 比較式が間違っていたので修正しました)
    If refiid.Data1 = 0 And refiid.Data2 = 0 And refiid.Data3 = 0 And _
        refiid.Data4(0) = &HC0 And refiid.Data4(1) = 0 And _
        refiid.Data4(2) = 0 And refiid.Data4(3) = 0 And _
        refiid.Data4(4) = 0 And refiid.Data4(5) = 0 And _
        refiid.Data4(6) = 0 And refiid.Data4(7) = &H46 Then
        ' IID_IUnknown の場合は ppv が指すポインターの先に This のアドレス(This の値)をコピー
        Debug.Print "  IID_IUnknown"
        Call CopyMemory(ByVal ppv, This, Len(This))
        ' さらに参照カウントを増やす
        Call My_AddRef(This)
        My_QueryInterface = S_OK
        Exit Function
    End If
    ' IID_IUnknown 以外はサポートしない
    Debug.Print "  E_NOINTERFACE"
    My_QueryInterface = E_NOINTERFACE
End Function

' ULONG STDMETHODCALLTYPE AddRef(THIS)
' 参照カウントを増やす際に呼び出される関数
Private Function My_AddRef(ByVal This As LongPtr) As Long
    Dim d As MyClassData
    ' インスタンスのデータを一旦 d にコピーし、
    ' 参照カウントを増やしたら書き戻す
    Call CopyMemory(d, ByVal This, Len(d))
    d.RefCount = d.RefCount + 1
    Debug.Print "My_AddRef: new RefCount ="; d.RefCount
    Call CopyMemory(ByVal This, d, Len(d))
    ' 戻り値は参照カウント
    My_AddRef = d.RefCount
End Function

' ULONG STDMETHODCALLTYPE Release(THIS)
' 参照カウントを減らす際に呼び出される関数(0 になったら破棄)
Private Function My_Release(ByVal This As LongPtr) As Long
    Dim d As MyClassData
    ' インスタンスのデータを一旦 d にコピーし、
    ' 参照カウントを減らしたら書き戻す
    Call CopyMemory(d, ByVal This, Len(d))
    d.RefCount = d.RefCount - 1
    Debug.Print "My_Release: new RefCount ="; d.RefCount
    Call CopyMemory(ByVal This, d, Len(d))
    ' 参照カウントが 0 になったら CoTaskMemFree で破棄する
    If d.RefCount = 0 Then
        Debug.Print "My_Release: destroy"
        Call CoTaskMemFree(This)
    End If
    ' 戻り値は参照カウント
    My_Release = d.RefCount
End Function

2つ前のコード例で定義した CreateInstanceMemory 関数が返す値はアドレス(ポインター)ですが、これを IUnknown 型の変数にコピーすることで、VBAのオブジェクトとして利用できるようになります。

※ IUnknown 型は標準で参照されている「stdole」ライブラリに隠しクラスとして含まれています。
※ 純粋な IUnknown インスタンスに対しては Object 型を用いることができません。これは、Object 型が IDispatch インターフェイスをベースに作られた型であるため、IDispatch インターフェイスを実装していないインスタンスを代入することができないためです。

Public Sub TestUnknownCreation1()
    Dim p As LongPtr
    ' インスタンスを作成
    p = CreateInstanceMemory()
    If p = 0 Then Exit Sub
    Dim unk As IUnknown
    ' unk を p が指すインスタンスに設定
    Call CopyMemory(unk, p, Len(p))
    ' このプロシージャを抜けると My_Release が呼び出される
End Sub

上記コード例にも書いていますが、CopyMemory によって変数 unk に自前で作成した IUnknown インスタンスが入るため、TestUnknownCreation1 プロシージャを抜ける際に unk をVBAが破棄しようとして IUnknown::Release メソッドを呼び出そうとし、その結果自前実装した My_Release 関数が呼び出されます。前述の My_Release 関数では参照カウントが 0 になった際に Debug.Print を実行しているため、イミディエイトウィンドウには「My_Release: new RefCount = 0」と「My_Release: destroy」が出力されます。

※ p はあくまで数値型と同様の扱いであるため、このプロシージャにおいて p に対しては特に何も行われません。

自前 IUnknown インスタンスによる終了処理のハンドリング

以上で「自前の IUnknown インスタンス」を作成することができましたが、これを「IUnknown::Release とオブジェクト」で紹介していたチェックコードにおける「MyClass1」の代わりに用いてみます。

Dim m_unk As IUnknown

Public Sub TestUnknownSub1()
    Dim p As LongPtr
    ' インスタンスを作成
    p = CreateInstanceMemory()
    If p = 0 Then Exit Sub
    Dim unk As IUnknown
    ' unk を p が指すインスタンスに設定
    Call CopyMemory(unk, p, Len(p))
    ' m_unk にセット(内部で My_AddRef が呼び出される)
    Set m_unk = unk
End Sub

Public Sub TestUnknownSub2()
    ' m_unk がセット済みの場合 My_Release が呼び出される
    Set m_unk = Nothing
End Sub

Public Sub TestUnknownSub3()
    If m_unk Is Nothing Then
        Debug.Print "m_unk is Nothing"
    Else
        Debug.Print "m_unk is not Nothing"
    End If
End Sub

このコードを記述後「TestUnknownSub1」を実行すると、自前 IUnknown のインスタンスが作られてさらに「Set m_unk = unk」で参照を増やしているため、My_AddRef 関数の呼び出し(「My_AddRef: new RefCount = 2」の出力)が発生します(直後に unk の破棄に対応する My_Release 呼び出しも発生して「My_Release: new RefCount = 1 」が出力されます)。今までと同様、この状態で「TestUnknownSub3」を実行すると「m_unk is not Nothing」が出力され、ここで「TestUnknownSub2」を実行するとインスタンス破棄による My_Release 呼び出しが発生して「My_Release: new RefCount = 0」「My_Release: destroy」が出力されます。

そして MyClass1 の場合と異なり、「TestUnknownSub1」を実行した後に(VBAの)リセットコマンドを実行すると、My_Release 関数の呼び出しが発生して「My_Release: new RefCount = 0」「My_Release: destroy」が出力されます。つまり、VBAの終了処理中に必ず「My_Release: destroy」の場所を通るため、何かしらのVBAの処理が実行されたときにモジュールのグローバル変数などに自前 IUnknown インスタンスを保持しておけば、リセット時に(自動的に IUnknown::Release が実行されるので)終了処理を記述することが可能になります。

以上をまとめた内容を「サンプルコード」のページに掲載しています。このページにあるコードを新規標準モジュールに貼り付け、「OnExit」プロシージャに任意のコードを記述し、その上で「SetExitHandler」プロシージャを実行することで、VBAの終了処理をハンドリングすることができます。