[ExcelVBA] EnumWindow関数を使って楽にハンドルを取得したい

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] WindowsAPI一覧

正直なところ毎回EnumWindow関数を書くのはしんどいので、関数化して簡単に利用できるようにしておきたい。
ということで、タイトル名を正規表現で渡して、一致する者のハンドルをキーに値にタイトルが入ったものが帰ってくる関数でも作ってみます。

段階を踏まえて書いてみます。
まずは、EnumWindowを使ってただハンドルをデバッグプリントしてみます。

Option Explicit

Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, lParam As Long) As Long
Sub GetHWND()
    '必ずエラーになるので止まらないよう処理しておく
    On Error Resume Next
    
    Dim Ret As Long
    Ret = EnumWindows(AddressOf EnumWindowsProc, 0)
    
    On Error GoTo 0
End Sub

Function EnumWindowsProc(ByVal HWND As Long) As Long
    EnumWindowsProc = 1
    
    Debug.Print HWND
End Function

Sub SampleCode()
    'コードを実行してみる
    Call GetHWND
End Sub

３行目：トップレベルにあるウィンドウハンドルを探してくれるEnumWindow関数の宣言です。
６行目：ハンドルを全て見つけた後や、途中でやめた時にエラーとなるのでエラー処理をしておきます
９行目：EnumWindow関数を呼ぶ。
　　　　第一引数はコールバック関数(ハンドルを見つけるたびにOSから呼出される関数)
　　　　第二引数はコールバック関数に受け渡しができる整数の値。特に使う予定がないので0としてます
　　　　戻り値は失敗したら０で成功したらそれ以外なんだと思うけど０しか見たことない…
11行目：エラー解除

コールバック関数側
15行目：戻り値を1(1:次のハンドルを探す,0:他のハンドルは探さず終了)
17行目：ハンドルを出力


次は、ハンドル名からウィンドウタイトルを出力してみます。

Option Explicit

Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, lParam As Long) As Long
Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
    (ByVal HWND As Long, ByVal MSG As Long, _
     ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SendMessageStr Lib "user32.dll" Alias "SendMessageA" _
    (ByVal HWND As Long, ByVal MSG As Long, _
     ByVal wParam As Long, ByVal lParam As String) As Long
Const WM_GETTEXT = &HD
Const WM_GETTEXTLENGTH = &HE
Sub GetHWND()
    '必ずエラーになるので止まらないよう処理しておく
    On Error Resume Next
    
    Dim Ret As Long
    Ret = EnumWindows(AddressOf EnumWindowsProc, 0)
    
    On Error GoTo 0
End Sub

Function EnumWindowsProc(ByVal HWND As Long) As Long
    EnumWindowsProc = 1
    
    'ハンドルに該当する文字列数を取得(注：Null文字は含まない)
    Dim length As Integer
    length = SendMessageStr(HWND, WM_GETTEXTLENGTH, 0, 0)
    length = length + 1 'Null文字分１つ増やす
    
    Dim str As String
    str = String(length, vbNullChar) 'Null文字分一つ多く領域を確保
    
    Dim Ret As Integer
    Ret = SendMessageStr(HWND, WM_GETTEXT, length, str) 'Null文字も含め受取る
    
    Dim WindowTitle As String
    WindowTitle = Left(str, Len(str) - 1)
    
    Debug.Print WindowTitle
End Function

Sub SampleCode()
    'コードを実行してみる
    Call GetHWND
End Sub

変更点の説明
４行目：ウィンドウタイトルの文字数を取得する際のメッセージを送るためSendMessage関数を宣言
７行目：ウィンドウタイトルの文字列を取得する際のメッセージを送るためSendMessageStr関数を宣言
10行目：ウィンドウタイトルの文字列を取得するためのメッセージを設定
11行目：ウィンドウタイトルの文字数を取得するためのメッセージを設定
コールバック関数内
26行目：ウィンドウタイトルの文字数を取得するための変数を宣言
27行目：SendMessage関数にハンドル、文字数取得のメッセージ、第3、第4引数は未使用のため０を指定
　　　　ハンドルからウィンドウタイトルの文字数を取得。
　　　　文字列を取得する際に文字列の最後にNull文字がついてくるが
　　　　ここでは、Null文字を除く文字数が帰ってくる。
28行目：文字列を取得する時Null文字もくっついてくるので1文字分多くしておく
30行目：文字列を受取るための変数を宣言
31行目：文字列+Null文字分に該当する文字数分、メモリを取得しておく
　　　　ここでは、Null文字(vbNullChar)を指定。
34行目：SendMessageStr関数に
　　　　ハンドル、文字列取得のメッセージ、受取る文字数、代入してもらう変数を指定
　　　　ハンドルの文字列を取得
37行目：文字列+Null文字なのでNull文字分切り落とす
39行目：ハンドルの文字列を出力


最終的には、ウィンドウのタイトルを引数に渡すとそれに該当するハンドルと名前をDictionaryに格納して返してくれる関数にしましょう。
ウィンドウのタイトルはあやふやでも指定できるよう、正規表現で指定できることにしましょう。

Option Explicit

Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, lParam As Long) As Long
Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
    (ByVal HWND As Long, ByVal MSG As Long, _
     ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SendMessageStr Lib "user32.dll" Alias "SendMessageA" _
    (ByVal HWND As Long, ByVal MSG As Long, _
     ByVal wParam As Long, ByVal lParam As String) As Long
Const WM_GETTEXT = &HD
Const WM_GETTEXTLENGTH = &HE
Dim RegWindowTitle As Object
Dim HWNDs As Object
Function GetHWND(ByVal WindowTitle As String, Optional IgnoreCase As Boolean = False)
    Set HWNDs = CreateObject("Scripting.Dictionary")
    Set RegWindowTitle = CreateObject("VBScript.RegExp")
    RegWindowTitle.Pattern = WindowTitle
    RegWindowTitle.Global = False
    RegWindowTitle.IgnoreCase = IgnoreCase
       
    '必ずエラーになるので止まらないよう処理しておく
    On Error Resume Next
    
    Dim Ret As Long
    Ret = EnumWindows(AddressOf EnumWindowsProc, 0)
    
    On Error GoTo 0
    
    Set GetHWND = HWNDs
    Set HWNDs = Nothing
    Set RegWindowTitle = Nothing
End Function


Function EnumWindowsProc(ByVal HWND As Long) As Long
    EnumWindowsProc = 1

    'ハンドルに該当する文字列数を取得(注：Null文字は含まない)
    Dim length As Integer
    length = SendMessageStr(HWND, WM_GETTEXTLENGTH, 0, 0)
    length = length + 1 'Null文字分１つ増やす
    
    Dim str As String
    str = String(length, vbNullChar) 'Null文字分一つ多く領域を確保
    
    Dim Ret As Integer
    Ret = SendMessageStr(HWND, WM_GETTEXT, length, str) 'Null文字も含め受取る
    
    
    '文字列を出力(NULL文字分１つ削って出力)
    Dim WindowTitle As String, MatchWindowTitle As Object
    WindowTitle = Left(str, Len(str) - 1)
    Set MatchWindowTitle = RegWindowTitle.Execute(WindowTitle)
    If 0 < MatchWindowTitle.Count Then
        HWNDs.Add HWND, WindowTitle
    End If
End Function


Sub SampleCode()
    Dim HWNDs As Object, HWND As Variant
    Set HWNDs = GetHWND("電卓")
    
    For Each HWND In HWNDs
        Debug.Print "[p]" & HWND & "," & HWNDs.Item(HWND)
    Next
End Sub

変更点の説明 12行目：コールバック関数(EnumWindowsProc関数)とは直接変数のやり取りができないので 　　　　外で宣言して使いまわす。RegWindowTitleは正規表現用のオブジェクト 13行目：ハンドルをキーにウィンドウタイトルを格納するためのDictionaryオブジェクト 14行目：SubからFunctionに変更。 　　　　第一引数は、ウィンドウタイトルを表す正規表現 　　　　第ニ引数は、正規表現のIgnoreCaseのプロパティ値。 　　　　Optionaryなので明示的に指定しなくても可。その際デフォルトは、大文字小文字の区別はしない。 15行目：Dictionaryオブジェクトの生成 16行目：正規表現オブジェクトの生成 17行目：正規表現を指定 18行目：繰り返し探しださない。 19行目：大文字小文字の識別は第二引数次第。 29行目：戻り値を指定。オブジェクトなのでSetを使っている 30,31行目：オブジェクトの使用後の処理 コールバック関数内 53行目：正規表現に一致するか調べる。 54行目：マッチしたか調べる 55行目：マッチした時は、Dictionaryオブジェクトにハンドルをキーにウィンドウタイトルを値に格納する サンプルコードでは電卓というタイトルがあれば ハンドルとタイトルを取得することにしています。

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] WindowsAPI一覧