[ExcelVBA] ウィンドウハンドルを取得する - WindowsAPI

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] ExcelVBA ALL >[ExcelVBA] AdventCalendar

アドベントカレンダー 14日目

クラス名がわかっていれば、FindWindow関数でも使ってハンドル取得すりゃいい話なんですが
わからん時は、いちいちEnumWindows関数で全ハンドル取得してウィンドウ名を取得して
該当するハンドルを見つけりゃいいわけですが、ちょいとめんどくさいから関数作ってしまいましょ。

関数の仕様としては、欲しいウィンドウハンドルの名前を指定します。
指定の仕方は正規表現で指定できます。
返り値は、DictionaryのObjectが返ってきます。

Dictionaryの構造は、ハンドルをキーに値にDicitionaryを持ちます。
そのDicitionaryは
ClassName という文字列をキーにクラス名を値に
WIndowName という文字列をキーにウィンドウ名を値に持ちます。

(Dictionary) = Hwnd => (Dictionary)
                                       "ClassName"     => [クラス名],
                                       "WIndowName" => [ウィンドウ名]
 

コードは以下の通りです。

Option Explicit

Private Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
       (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private 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

Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE

Private DicHwnd As Object
Private RegWindowTitle As Object

Public Function GetHwnd(ByVal RegPattern As String) As Object
    Dim Ret As Long
    
    'FileNameに一致するハンドルをキーにタイトルを値に格納する変数
    'CallBack関数とやりとりするのでGlobal領域で宣言しておく
    Set DicHwnd = CreateObject("Scripting.Dictionary")
    Set RegWindowTitle = CreateObject("VBScript.RegExp")
    
    RegWindowTitle.Global = False
    RegWindowTitle.IgnoreCase = True
    RegWindowTitle.Pattern = EscapeRegString(RegPattern)

    '必ずエラーになるので止まらないよう処理しておく
    On Error Resume Next
    Ret = EnumWindows(AddressOf EnumWindowsProc, 0)
    On Error GoTo 0 '問題の部分を過ぎたのでエラー処理をもとに戻す
    
    Set GetHwnd = DicHwnd
    Set DicHwnd = Nothing
End Function

Private Function EnumWindowsProc(ByVal hwnd As Long) As Long
    Dim ClassName   As String
    Dim length      As Integer
    Dim Ret         As Integer
    Dim str         As String
    Dim WindowTitle As String
    
    EnumWindowsProc = 1
    
    'ハンドルに該当する文字列数を取得(注：Null文字は含まない)
    length = SendMessageStr(hwnd, WM_GETTEXTLENGTH, 0, 0)
    length = length + 1 'Null文字分１つ増やす
    
    'Null文字分一つ多く領域を確保
    str = String(length, vbNullChar)
    
    'Null文字も含め受取る
    Ret = SendMessageStr(hwnd, WM_GETTEXT, length, str)
    
    '文字列を出力(NULL文字分１つ削って出力)
    WindowTitle = Left(str, Len(str) - 1)
    
    '取得したウィンドウ名がGetHwndの引数に指定された正規表現がマッチしたら取得しておく
    If RegWindowTitle.Test(WindowTitle) Then
        'クラス名が何文字か不明なので大きめの領域を確保しておく
        ClassName = String(255, vbNullChar)
        Ret = GetClassName(hwnd, ClassName, 255)
        ClassName = Replace(ClassName, vbNullChar, "")
        
        DicHwnd.Add CStr(hwnd), CreateObject("Scripting.Dictionary")
        DicHwnd(CStr(hwnd)).Add "ClassName", ClassName
        DicHwnd(CStr(hwnd)).Add "WindowName", WindowTitle
    End If
    
End Function

Private Function EscapeRegString(ByVal RegHwnd As String)
    RegHwnd = Replace(RegHwnd, "(", "\(")
    RegHwnd = Replace(RegHwnd, ")", "\)")
    RegHwnd = Replace(RegHwnd, ".", "\.")
    RegHwnd = Replace(RegHwnd, "[", "\[")
    
    EscapeRegString = RegHwnd
End Function

こんな感じで値が取れます。
メモ帳を2つ起動した状態で、メモ帳のハンドルを取得したいとします。

Option Explicit

Sub SampleCode()
    Dim hwnd     As Variant
    Dim HashHwnd As Object
    Set HashHwnd = GetHwnd("メモ帳$")
    
    For Each hwnd In HashHwnd
        Debug.Print "ハンドル:" & hwnd
        Debug.Print "クラス名:" & HashHwnd(hwnd)("ClassName")
        Debug.Print "タイトル:" & HashHwnd(hwnd)("WindowName")
        Debug.Print "---"
    Next
End Sub

実行結果

ハンドル:197350
クラス名:Notepad
タイトル:無題 - メモ帳
---
ハンドル:262876
クラス名:Notepad
タイトル:無題 - メモ帳
---

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] ExcelVBA ALL >[ExcelVBA] AdventCalendar