EnumWindowsを使って別プロセスのExcelを取得してみた

今日はVBAでWinAPIのEnumWindowsを使って別プロセスのExcelを取得する関数を作ってみました。

---

きっかけ

以前投稿したイミディエイトウィンドウの使い方の記事で、イミディエイトウィンドウを初期化する方法が不完全なままになっていた。

www.excel-chunchun.com

というのも、VBAからApplication.VBEへアクセスするにはセキュリティを外さなければならず、以下のような構文が使えなかったのである。

Sub ImdClear_G_A_Del_F7()
    On Error GoTo ENDPOINT
    '↓ここから規制対象
    If Application.VBE.MainWindow.Visible And _
        Application.VBE.Windows("イミディエイト").Visible Then
        '↑ここまでが規制対象
            SendKeys "^g", True
            SendKeys "^a", True
            SendKeys "{Del}", True
            SendKeys "{F7}", True
    End If
ENDPOINT:
End Sub

そこで、どうにかして「VBAプロジェクトオブジェクトモデルへのアクセスを信頼する。」がOFFの状態で

• VBEが開かれているか
• イミディエイトが開かれているか
• イミディエイトがドッキングされているか/ポップアップされているか

を、調べる関数を目指して、Windowsの基本に返ってAPIに頼ることにした。

APIによりウィンドウを取得する方法は、大きく分けて2つある。

• FindWindow、FindWindowExを使ってクラス名等からピンポイントに引き当てる方法
• EnumWindows、EnumChildWindowsを使って全てのウィンドウから巡回して探し当てる方法

FindWindowのほうがお手軽なのだが、複数同時起動している場合には「どれか一つ」しか取得できないという問題がある。

追記：FindWindowExにはhChildAfterがあり、検索開始ハンドル指定して繰り返し実行することで複数同時起動している場合に対応出来るらしい。

また、予めクラス名を特定おかなければならないというのも、取っ付きづらい原因の一つかもしれない。（今回は一括で取得してからLike演算子でフィルタリングしている）

以前、EnumWindows及びコールバック関数作成の練習で一度作ったことがあった。

一度作ったものなら多少の改良でVBE等にも流用出来るだろうと、作りっぱなしになっていたものを改良することにした。

（書き方がひどすぎて、結果的に完全に書き下ろす形になってしまったが。）

というわけで、ようやく本題の「別プロセスのExcelを取得する関数」を作ることになったわけである。

EnumWindows関数

今回のキモとなるAPIはEnumWindowsとEnumChildWindowsである。

Declare PtrSafe Function EnumWindows Lib "user32.dll" _
    (ByVal lpEnumFunc As LongPtr, _
        ByVal lParam As LongPtr) As LongPtr

このEnumWindowsには一つVBAに無い面白い特徴がある。

ここ最近、私のTLで話題なコールバック関数を使用するのである。

たとえば、EnumWindowsを使う時はこのような記述をする。

lngRtnCode = EnumWindows( _
    AddressOf Callback_EnumWindowsProc, _
    ByVal 0&)

引数	渡した値	意味
lpEnumFunc As LongPtr	AddressOf Callback_EnumWindowsProc	コールバック関数へのポインタ
lParam As LongPtr	ByVal 0&	固定だと思って良し

コールバック関数とは

次にコールバック関数だが、この概念を口頭だけで近いするのは困難を極めるので、（頑張って説明文を書いたが）ソースコードを実際に動かして体感したほうが絶対に良い。

私のイメージとしては、

関数Aが関数Bに「処理の最中で定期的に『ある操作』をやっといて」するための関数である。

この「ある操作」に相当するのが、「コールバック関数」である。

関数というプロセスそのものを丸投げしなければならないので、AddressOf演算子を使って関数への参照(ポインタ)を引数として渡している。

「コールバック関数」という仰々しい(?)名前がついているが、要はAPI側の仕様に沿った「ただの関数」である。

「引数」と「戻り値」さえ正しい形になっていれば、中の処理は何をしても構わない。

慣習で、みな同じような「関数名」にしているが、実際にはなんでも良い。

' コールバック関数 - 親ウィンドウ列挙
Private Function Callback_EnumWindowsProc( _
        ByVal hWnd As LongPtr, _
        ByVal lParam As LongPtr) As LongPtr
    
    'モジュールレベル変数のDictionaryにhWndをストックする
    DicParentWindows.Add "" & hWnd, lParam
    
    '内容を確認するためにイミディエイトへ出力してみる
    Debug.Print hWnd, lParam
    
    '処理を続行する場合はTrueを返す
    Callback_EnumWindowsProc = True
End Function

例えば、先ほどの

lngRtnCode = EnumWindows( _
    AddressOf Callback_EnumWindowsProc, _
    ByVal 0&)

を実行した場合、User32.dllの中のEnumWindowsがOSの管理しているウィンドウを巡回して、ウィンドウを発見するたびにCallback_EnumWindowsProcを実行してくれる。

デバッグしてみれば分かるが、猛スピードでイミディエイトのログが流れるはず。

VBA的にはEnumWindows()を一回実行しただけなのにも関わらず。だ。

たぶん、というか間違いなく、EnumWindowsの実装は繰り返し文になっている。

'ことりちゅんの「たぶん、こうだったんだろう劇場」
'想像で書いた EnumWindows の実装
Do
    '何らかの処理
    hWnd = ほにゃらら
    lParam = ふにゃふにゃ
    
    'もしFalseを返されたら処理を中断
    If Callback_EnumWindowsProc(hWnd, lParam) = False Then Exit Do
Loop

全ての巡回が終わったらようやくEnumWindows()を呼び出した側のステップが次へ進む。

ただし、Callback_EnumWindowsProcは何十・何百と呼ばれるのは良いものの、結果を保持することができないので、内部で処理を済ませるかパブリック変数を通して結果をフィードバックする仕組みが必要になる。

EnumWindows()について調べていると、前者のサンプルが非常に多いのだが、慣れない私は処理の流れが読みづらくて凄く難解に見えてしまう。

だから今回は後者の方法を取った。すごくシンプルでしょう？

' コールバック関数 - 親ウィンドウ列挙
Private Function Callback_EnumWindowsProc( _
        ByVal hWnd As LongPtr, _
        ByVal lParam As LongPtr) As LongPtr
    DicParentWindows.Add "" & hWnd, lParam
    Callback_EnumWindowsProc = True
End Function

最後のlParamについては省略する。

EnumChildWindows関数

EnumChildWindowsは「親を持つ」子や孫のウィンドウハンドルの巡回用の関数で、引数に親のウィンドウハンドルが増えただけで仕組みとしては何も変わらない。

Declare PtrSafe Function EnumChildWindows Lib "user32.dll" _
    (ByVal hWndParent As LongPtr, _
        ByVal lpEnumFunc As LongPtr, _
        ByVal lParam As LongPtr) As LongPtr

EnumChildWindowsはこんな記述をする。

Dim lngRtnCode As LongPtr
lngRtnCode = EnumChildWindows( _
    hWndParent, _
    AddressOf Callback_EnumChildWindowsProc, _
    lParamParent)

引数	渡した値	意味
hWndParent As LongPtr	hWndParent	親ウィンドウのハンドル
lpEnumFunc As LongPtr	AddressOf Callback_EnumChildWindowsProc	コールバック関数へのポインタ
lParam As LongPtr	lParamParent	親ウィンドウ取得時のlParam

ウィンドウハンドルとは

ウィンドウハンドルだが、

• ウィンドウ・・・Windowsの機能で作成されたオブジェクト
• ハンドル・・・・起動中のPCで、絶対に重複しないように割り振られたオブジェクトのID

という感じである。でも、たぶんまだ「オブジェクト」が何なのか分からないはずなので、具体例を上げる。

• デスクトップ　とか　タスクバー　とかの　「最初からある奴」
• エクスプローラ　とか　Google Chrome　とかの「窓」
• エクスプローラとかに表示されている「ツールバー」とか「ボタン」とか「リスト」とかの「部品」

まあ、つまり、

画面上の部品一つ一つに「ウィンドウハンドル」＝「絶対に重複しないOSの管理番号」が付いているとでも想像すれば良い。

ある程度まで細分化した段階でOSの管理外となるが、今回はそこまで意識しなくて良い。

（例えば3DのゲームとかFlashとかは、窓以外は全てOSの管理外になるしね）

今回はとにかく「実行中のエクセルの窓」が全て取得出来れば良いのである。

いずれの関数も、返す値は「ウィンドウハンドル」である。

APIを使うときには「ウィンドウハンドル」が非常に重要となるため、Windowsのアプリ開発をする人は理解しておく事をオススメしたい。

使い方

Excelの場合

とりあえず、標準モジュールに貼って、テストプロシージャを実行してみればOK

テスト	意味	テスト対象の関数
Test_ExecExcelApps	実行中Excelアプリケーションの列挙	ExecExcelApps
Test_ExecExcelWorkbooks	実行中Excelワークブックの列挙	ExecExcelWorkbooks
Test_ExecExcelWindows	実行中Excelウィンドウの列挙	ExecExcelWindows

異なるプロセスでExcelを2つ開き、適当なブックを開いて３つを実行するとこんな感じになった。

Test_ExecExcelApps - 22:56:45
ハンドル     ブック数  アプリケーション名
 4657694       2    Book1 - Excel
 19734440      3    20190929_EnumWindowsを使って別プロセスのExcelを取得する.xlsm - Excel

Test_ExecExcelWorkbooks - 22:56:46
ハンドル     窓数   ブック名
 4657694       1    Book1
 19734440      1    20190929_EnumWindowsを使って別プロセスのExcelを取得する.xlsm
 19734440      1    20190209_VBAのデバッグにおける真のイミディエイトウィンドウの使い方.xlsm
 19734440      2    Book2
 4657694       1    PERSONAL.XLSB

Test_ExecExcelWindows - 22:56:47
ハンドル     ゼロ   ウィンドウタイトル
 4657694       0    Book1
 19734440      0    20190929_EnumWindowsを使って別プロセスのExcelを取得する.xlsm
 19734440      0    20190209_VBAのデバッグにおける真のイミディエイトウィンドウの使い方.xlsm
 19734440      0    Book2  -  2
 19734440      0    Book2  -  1
 4657694       0    PERSONAL.XLSB

なぜ「アプリケーション」「ブック」「ウィンドウ」の3つを作っているか、どう使い分けるかは、Excelのオブジェクトツリーを学ぶと良い。

Excel以外の場合

Excelのために先の関数を作ったが、もちろんExcel以外にも対応している。

関数名	意味
EnumFindWindows	親を持たないトップレベルウィンドウのハンドル一覧を返す関数
EnumFindChildWindows	指定した親クラスに含まれる子孫ウィンドウハンドルを返す関数

いずれもAPIのGetClassNameとGetWindowTextを元に、VBAのLike演算子で絞り込みが出来るようになっている。

EnumFindWindows関数

親を持たないトップレベルウィンドウのハンドル一覧を返す関数

' @param parent_class_name  Likeフィルタ用親クラス名(省略可)
' @param parent_window_text Likeフィルタ用親テキスト(省略可)

EnumFindChildWindows関数

指定した親クラスに含まれる子孫ウィンドウハンドルを返す関数

' @param parent_class_name  Likeフィルタ用親クラス名(省略可)
' @param parent_window_text Likeフィルタ用親テキスト(省略可)
' @param child_class_name   Likeフィルタ用子クラス名(省略可)
' @param child_window_text  Likeフィルタ用子テキスト(省略可)

ウィンドウテキストの方はプログラム次第で変化してしまうため、できればクラス名を使うと良い。

しかしクラス名はどうにかして特定する必要がある。

• フリーソフトを使う
• 本プログラムでウィンドウテキスト（タイトル）で絞り込み、リストアップされた中から目的のクラスを探す
• psrを使う（Windows標準のステップ記録ツール）

など、他にも色々手段がある。

ハマったこと

DictionaryのキーにはLongLong型を使用できない

あまりハマったことはないのだが、64bit対応に当たって思わぬ障害に衝突した。

先ほどから登場しているコールバック関数だが、実はDictionaryのキー部分のハンドル値を「文字列」に置き換えるという、とてもオカシナ事をしている。

' コールバック関数 - 親ウィンドウ列挙
Function Callback_EnumWindowsProc( _
        ByVal hWnd As LongPtr, _
        ByVal lParam As LongPtr) As LongPtr
    DicParentWindows.Add "" & hWnd, lParam
    Callback_EnumWindowsProc = True
End Function

これには止むに止まれぬ事情があって、

DictionaryのキーにはLongLong型を使用できない

らしいのである。（参考資料が見つからず。諦めた。）

Dictionaryのキー部分は、ハッシュなので通常なんでも設定出来てしまう。

（数値でも、実数でも、文字列でも、Rangeでも）それなのに、LongLongはダメらしい。

また、Itemの方には、普通にLongLongのlParamが設定出来ている。

後日入手した情報によると、Decimal型ならLongに入り切らない大きな値でもキーにできることが判明した。

管理者として実行されたプロセスは取得できない

普通にエクセルブックを開いた場合、プロセスの権限がはユーザーレベルとなる。

ユーザーレベルで実行されているプロセスから、SYSTEMレベル（管理者権限）で動いているプロセスにアクセスすることは出来ない。

従って、ウィンドウハンドルを取得する所までは問題無いのだが、GetExcelWindowByHWndでやっているオブジェクト化の処理（ObjectFromLresult関数）

lngResult = SendMessage(hWnd, WM_GETOBJECT, 0, ByVal OBJID_NATIVEOM)
If lngResult Then
    bytID = IID_IDispatch & vbNullChar
    IIDFromString bytID(0), IID(0)
    lngRtnCode = ObjectFromLresult(lngResult, IID(0), 0, excelWindow)
End If

が失敗してしまうのである。

これはOSがセキュリティ強化のために行っている仕様なので仕方がないのだが、それでも困るという場面はあると思う。

問題を回避するためには、ブックを管理者として実行しておけば良い。

管理者としてエクセルを起動するには、ブックではなく実行ファイルを右クリックして管理者として実行してから、目的のマクロブックを開く必要がある。

この操作は地味に面倒なので、私はCtrl+Shift+exeを実行という方法をよく使っている。

また、管理者として実行していた場合でも保護ビュー等の状態のExcelはオブジェクト化できないので、除外するように記述した。

ソースコード

400行近い長大なコードなので折りたたみでお送りする。

▶ソースコードを展開

'--------------------------------------------------
'起動中のウィンドウをリストアップする関数
'
'公開先
' えくせるちゅんちゅん
' 2019/10/01
' 20190929 EnumWindowsを使って別プロセスのExcelを取得してみた
' https://www.excel-chunchun.com/entry/enumwindows-excel-vba
'
'--------------------------------------------------
'更新履歴
' 2019/09/29 初回版完成
' 2019/10/01 保護ビューに対応
'
'--------------------------------------------------
Option Explicit

Private Declare PtrSafe Function EnumWindows Lib "user32.dll" _
                        (ByVal lpEnumFunc As LongPtr, _
                         ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClassName Lib "user32.dll" _
                        Alias "GetClassNameA" _
                        (ByVal hWnd As LongPtr, _
                         ByVal lpClassName As String, _
                         ByVal nMaxCount As LongPtr) As LongPtr
Private Declare PtrSafe Function EnumChildWindows Lib "user32.dll" _
                        (ByVal hWndParent As LongPtr, _
                         ByVal lpEnumFunc As LongPtr, _
                         ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function GetWindowText Lib "user32.dll" _
                        Alias "GetWindowTextA" _
                        (ByVal hWnd As LongPtr, _
                         ByVal lpString As String, _
                         ByVal nMaxCount As LongPtr) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" _
                        Alias "SendMessageA" _
                        (ByVal hWnd As LongPtr, ByVal Msg As LongPtr, _
                         ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function IIDFromString Lib "ole32" _
                        (lpsz As Any, lpiid As Any) As LongPtr
Private Declare PtrSafe Function ObjectFromLresult Lib "oleacc" _
                        (ByVal lResult As LongPtr, riid As Any, _
                         ByVal wParam As LongPtr, ppvObject As Any) As LongPtr
Private Declare PtrSafe Function IsWindow Lib "user32" _
                        (ByVal hWnd As LongPtr) As LongPtr

Private Const OBJID_NATIVEOM = &HFFFFFFF0
Private Const OBJID_CLIENT = &HFFFFFFFC

Private Const IID_IMdcList = "{8BD21D23-EC42-11CE-9E0D-00AA006002F3}"
Private Const IID_IUnknown = "{00000000-0000-0000-C000-000000000046}"
Private Const IID_IDispatch = "{00020400-0000-0000-C000-000000000046}"

Private Const WM_GETOBJECT = &H3D&

'-----
'よく使うプログラムのクラス名
Private Const WINDOW_CLASS_EXCEL = "XLMAIN"
Private Const WINDOW_CLASS_VBE = "wndclass_desked_gsk"
Private Const CHILD_CLASS_EXCELWINDOW = "EXCEL7"
Private Const CHILD_CLASS_VBE = "VbaWindow"

'-----
Private DicParentWindows As Object  'Dictionary
Private DicChildWindows As Object   'Dictionary

' コールバック関数 - 親ウィンドウ列挙
'   DicParentWindows にスタックする
Private Function Callback_EnumWindowsProc(ByVal hWnd As LongPtr, _
                                    ByVal lParam As LongPtr) As LongPtr
    DicParentWindows.Add "" & hWnd, lParam
    Callback_EnumWindowsProc = True
End Function

' コールバック関数 - 子ウィンドウを列挙
'   DicChildWindows にスタックする
Private Function Callback_EnumChildWindowsProc(ByVal hwndChild As LongPtr, _
                                  ByVal lParam As LongPtr) As LongPtr
    DicChildWindows.Add "" & hwndChild, lParam
    Callback_EnumChildWindowsProc = True
End Function

' クラス名取得
Private Function GetClassNameRap(hWnd As Variant) As String
    Dim strClassBuff    As String * 128
    Dim lngRtnCode      As LongPtr
    lngRtnCode = GetClassName(hWnd, strClassBuff, Len(strClassBuff))
    GetClassNameRap = Left(strClassBuff, InStr(strClassBuff, vbNullChar) - 1)
End Function

' テキスト取得
Private Function GetWindowTextRap(hWnd As Variant) As String
    Dim lngRtnCode      As LongPtr
    Dim strTextBuff     As String * 516
    lngRtnCode = GetWindowText(hWnd, strTextBuff, Len(strTextBuff))
    GetWindowTextRap = Left(strTextBuff, InStr(strTextBuff, vbNullChar) - 1)
End Function

'ウィンドウクラスとテキストがLike基準の判定で条件を満たすか
'
'引数
' @param hWnd        ウィンドウハンドル
' @param class_name  Likeフィルタ用クラス名(必須だが空欄可)
' @param window_text Likeフィルタ用テキスト(必須だが空欄可)
'
'戻り値
' @return As Boolean 条件を満たしていたか
'
'注意
' @note クラスとテキスト双方を指定した場合はAND比較される。
' @note どちらも省略か空欄の場合は常にFalseを返す。
'
Private Function CompWindow(hWnd, class_name, window_text) As Boolean
    CompWindow = False
    If Not IsMissing(class_name) Then
        If class_name <> "" Then
            CompWindow = (GetClassNameRap(hWnd) Like class_name)
        End If
    End If
    If Not IsMissing(window_text) Then
        If window_text <> "" Then
            CompWindow = (GetWindowTextRap(hWnd) Like window_text)
        End If
    End If
End Function

'親を持たないトップレベルウィンドウのハンドル一覧を返す関数
'
'引数
' @param parent_class_name  Likeフィルタ用親クラス名(省略可)
' @param parent_window_text Likeフィルタ用親テキスト(省略可)
'
'戻り値
' @return As Variant/Variant(0 to #) 親のウィンドウハンドル配列
'
'注意
' @note クラスとテキスト双方を指定した場合は双方を満たす必要がある。
' @note どちらも省略か空欄の場合は常にFalseを返す。
' @note 全てを取得したいのであれば、"*"(アスタリスク)を指定する。
'
Public Function EnumFindWindows(Optional parent_class_name As Variant, _
                                Optional parent_window_text As Variant _
                                ) As Variant
    
    Dim lngRtnCode As LongPtr
    Dim dic As Object
    Dim hWnd
    
    Set DicParentWindows = CreateObject("Scripting.Dictionary")
    
    ' 親ウィンドウを列挙
    '結果は DicParentWindows へ返る
    lngRtnCode = EnumWindows(AddressOf Callback_EnumWindowsProc, ByVal 0&)
    
    ' ウィンドウクラス・テキストでフィルタリング
    Set dic = CreateObject("Scripting.Dictionary")
    For Each hWnd In DicParentWindows.Keys
        If CompWindow(hWnd, parent_class_name, parent_window_text) Then
            dic.Add "" & hWnd, DicParentWindows("" & hWnd)
'            Debug.Print hWnd, GetClassNameRap(hWnd), GetWindowTextRap(hWnd)
        End If
    Next
    Set DicParentWindows = dic
    
    EnumFindWindows = DicParentWindows.values
    
End Function

'指定した親クラスに含まれる子孫ウィンドウハンドルを返す関数
'
'引数
' @param parent_class_name  Likeフィルタ用親クラス名(省略可)
' @param parent_window_text Likeフィルタ用親テキスト(省略可)
' @param child_class_name   Likeフィルタ用子クラス名(省略可)
' @param child_window_text  Likeフィルタ用子テキスト(省略可)
'
'戻り値
' @return As Variant/Variant(0 to #) 子や孫のウィンドウハンドル配列
'
'注意
' @note クラスとテキスト双方を指定した場合は双方を満たす必要がある。
' @note どちらも省略か空欄の場合は常にFalseを返す。
' @note 全てを取得したいのであれば、"*"(アスタリスク)を指定する。
'
Public Function EnumFindChildWindows(Optional parent_class_name As Variant, _
                                     Optional parent_window_text As Variant, _
                                     Optional child_class_name As Variant, _
                                     Optional child_window_text As Variant _
                                     ) As Variant
    
    Set DicParentWindows = CreateObject("Scripting.Dictionary")
    Set DicChildWindows = CreateObject("Scripting.Dictionary")
    
    Dim lngRtnCode As LongPtr
    Dim dic As Object
    Dim hWnd
    
    ' 親ウィンドウを列挙
    '結果は DicParentWindows へ返る
    lngRtnCode = EnumWindows(AddressOf Callback_EnumWindowsProc, ByVal 0&)
    
    ' ウィンドウクラス・テキストでフィルタリング
    Set dic = CreateObject("Scripting.Dictionary")
    For Each hWnd In DicParentWindows.Keys
        If CompWindow(hWnd, parent_class_name, parent_window_text) Then
            dic.Add "" & hWnd, DicParentWindows("" & hWnd)
'            Debug.Print hWnd, GetClassNameRap(hWnd), GetWindowTextRap(hWnd)
        End If
    Next
    Set DicParentWindows = dic
    
    ' 子ウィンドウを列挙
    For Each hWnd In DicParentWindows.Keys
        '結果は DicChildWindows へ返る
        lngRtnCode = EnumChildWindows( _
            hWnd, _
            AddressOf Callback_EnumChildWindowsProc, _
            DicParentWindows(hWnd))
    Next
    ' ウィンドウクラス・テキストでフィルタリング
    Set dic = CreateObject("Scripting.Dictionary")
    For Each hWnd In DicChildWindows.Keys
        If CompWindow(hWnd, child_class_name, child_window_text) Then
            dic.Add "" & hWnd, DicParentWindows("" & hWnd)
'            Debug.Print hWnd, GetClassNameRap(hWnd), GetWindowTextRap(hWnd)
        End If
    Next
    Set DicChildWindows = dic
    
    EnumFindChildWindows = DicChildWindows.Keys
End Function

'ウィンドウハンドルからExcel.Windowオブジェクトを取得
'
'引数
' @param hWnd ウィンドウハンドル
'
'戻り値
' @return As Excel.Window エクセルウィンドウオブジェクト
'
'注意
' 対象のプロセスが別のユーザー権限で実行されている場合
' 取得に失敗することがありNothingを返します
'
Private Function GetExcelWindowByHWnd(hWnd) As Excel.Window

    Dim IID(0 To 3) As Long
    Dim bytID()     As Byte
    Dim lngResult   As LongPtr
    Dim lngRtnCode  As LongPtr
    Dim excelWindow As Excel.Window

    If IsWindow(hWnd) = 0 Then Exit Function
    
    lngResult = SendMessage(hWnd, WM_GETOBJECT, 0, ByVal OBJID_NATIVEOM)
    If lngResult Then
        bytID = IID_IDispatch & vbNullChar
        IIDFromString bytID(0), IID(0)
        lngRtnCode = ObjectFromLresult(lngResult, IID(0), 0, excelWindow)
    End If
    
    Set GetExcelWindowByHWnd = excelWindow
    
End Function

'実行中の全Excelウィンドウオブジェクトを取得
'
'戻り値
' @return As Excel.Window(0 To #) エクセルウィンドウオブジェクトの配列
'
'注意
' @note 権限の異なるプロセスは取得に失敗するため除外する
' @note > Excelを管理者として実行しておけば回避可能
' @note 管理者権限でも保護ビューは操作不能なので除外する
' @note >※1と※2の場合がある。無理に操作するとクラッシュする
'
Private Function ExecExcelWindows() As Variant

    'ExcelProcess().excelWindow().hWndを列挙したような結果が返る
    Dim arrHWnd
    arrHWnd = EnumFindChildWindows(parent_class_name:=WINDOW_CLASS_EXCEL, _
                                    child_class_name:=CHILD_CLASS_EXCELWINDOW)
                                    
    Dim arrRetVal
    ReDim arrRetVal(LBound(arrHWnd) To UBound(arrHWnd))
    Dim i As Long, j As Long: j = LBound(arrHWnd) - 1
    
    For i = LBound(arrHWnd) To UBound(arrHWnd)
        j = j + 1
        Set arrRetVal(j) = GetExcelWindowByHWnd(arrHWnd(i))
        '権限不足で取得失敗
        If arrRetVal(j) Is Nothing Then j = j - 1
        '保護ビューのため取得しても操作不能(※1)
        If TypeName(arrRetVal(j)) = "ProtectedViewWindow" Then j = j - 1
        '保護ビューのため取得しても操作不能(※2)
        If arrRetVal(j).Application.hWnd = 0 Then j = j - 1
    Next
    
    If j < LBound(arrHWnd) Then
        ExecExcelWindows = Array()
    Else
        ReDim Preserve arrRetVal(LBound(arrHWnd) To j)
        ExecExcelWindows = arrRetVal
    End If
    
End Function

'起動中のエクセルのApplicationオブジェクトの配列を返す
'
'戻り値
' @return As Excel.Application(0 To #)  オブジェクトの配列
'
'注意
' @note 保護ビューのウィンドウはhWndが0になる。
' @note アクセスするとExcelがクラッシュする恐れがあるため除外する。
'
Public Function ExecExcelApps() As Variant
    
    'Application.hWndの重複削除
    Dim dic  As Object: Set dic = CreateObject("Scripting.Dictionary")
    Dim win  As Variant
    Dim hWnd As String
    
    For Each win In ExecExcelWindows()
        hWnd = "" & win.Application.hWnd
        If hWnd = "0" Then
'            Debug.Print "保護ビューかも"   '対処済なので理論上到達しない
        Else
            If Not dic.Exists(hWnd) Then
                dic.Add hWnd, win.Application
'                Debug.Print hWnd, Win.Application.Caption
            End If
        End If
    Next
    
    ExecExcelApps = dic.Items
    
End Function

'起動中のエクセルのWorkbookオブジェクトの配列を返す
'
'戻り値
' @return As Excel.Application(0 To #)  オブジェクトの配列
'
'注意
' @note 保護ビューのウィンドウはhWndが0になる。
' @note アクセスするとExcelがクラッシュする恐れがあるため除外する。
'
Public Function ExecExcelWorkbooks() As Variant
    
    'Application.hWndの重複削除
    Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
    Dim win As Variant
    Dim hWnd As String
    
    For Each win In ExecExcelWindows()
        hWnd = "" & win.Application.hWnd
        If hWnd = "0" Then
'            Debug.Print "保護ビューかも"   '対処済なので理論上到達しない
        Else
            If Not dic.Exists(win.Parent.Name) Then
                dic.Add win.Parent.Name, win.Parent
    '            Debug.Print Win.Parent.Name, Win.Parent.Name
            End If
        End If
    Next
    
    ExecExcelWorkbooks = dic.Items
    
End Function

'実行中Excelアプリケーションの列挙
'※App.Captionはアクティブブックの名前が出力されるので保護されてても出てくる
Sub Test_ExecExcelApps()
    DpS "Test_ExecExcelApps"
    Dim App         As Variant
    Debug.Print "ハンドル", "ブック数", "アプリケーション名"
    For Each App In ExecExcelApps()
        Debug.Print App.hWnd, App.Workbooks.Count, App.Caption
    Next
End Sub

'実行中Excelワークブックの列挙
Sub Test_ExecExcelWorkbooks()
    DpS "Test_ExecExcelWorkbooks"
    Dim wb         As Variant
    Debug.Print "ハンドル", "窓数", "ブック名"
    For Each wb In ExecExcelWorkbooks()
        Debug.Print wb.Application.hWnd, wb.Windows.Count, wb.Name
    Next
End Sub

'実行中Excelウィンドウの列挙
Sub Test_ExecExcelWindows()
    DpS "Test_ExecExcelWindows"
    Dim win         As Variant
    Dim hWnd As String
    
    Debug.Print "ハンドル", "ゼロ", "ウィンドウタイトル"
    For Each win In ExecExcelWindows()
        If win Is Nothing Then
'            Debug.Print "err"
        ElseIf TypeName(win) = "ProtectedViewWindow" Then
'            Debug.Print "err"
        ElseIf win.Application.hWnd = 0 Then
'            Debug.Print "保護ビューかも"
        Else
            Debug.Print win.Application.hWnd, 0, win.Caption
        End If
    Next
End Sub

まとめ

こんなものを作って、一体何に使うのか全く想像がつかないが、先日作ったような「疑似マルチスレッド」をする時に使えるのかも知れない。

www.excel-chunchun.com

誰か面白い使い方を思いついたら、遠慮なくコメント欄 or Twitterで教えてほしい。

今回はVBEに対して処理するところまでは出来なかったので、もう少し改良したいと思う。

以上

---

何か御座いましたらコメント欄、またはTwitterからどうぞ♪

それではまた来週♪　ちゅんちゅん(・8・)