[ExcelVBA] EnumWindows

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

■説明
画面上のすべてのトップレベルウィンドウを列挙する関数。
ウィンドウのハンドルを見つけるとそれがトリガーとなり
指定した関数を呼び出します。
指定した関数は、戻り値が1の時だけ次のハンドルを探すプロセスに移ります。

この関数が終了する時は、トップレベルのウィンドウハンドルを全て見つけた時と
指定した関数が0を返した時になります。
いずれもエラーを起こすのでエラー処理が必要となります。



■宣言
Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, lParam As Long) As Long
lpEnumFunc：ハンドルを見つけた際にハンドルを受け渡す関数名を指定します。
(関数の指定には、AddressOf演算子を使います)
lParam ：指定した関数に渡すアプリケーション定義の値を指定
戻り値　　：関数が成功すると、0 以外の値が返ります。
※定義としては、上の通りですが0以外の値を見たことがない…

■サンプルコード
まずは、APIの宣言とEnumWindows関数の使用とハンドルが見つかった際に呼び出す関数を作成します

view plainprint?

1. Option Explicit  
2.   
3. Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, lParam As Long) As Long  
4. Sub SampleCode()  
5.     Dim Ret As Long  
6.     Ret = EnumWindows(AddressOf hogehoge, 0)  
7.   
8.     Debug.Print Time  
9. End Sub  
10.   
11. Function hogehoge(ByVal hwnd As Long) As Long  
12.     Debug.Print hwnd  
13. End Function  

Option Explicit

Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, lParam As Long) As Long
Sub SampleCode()
    Dim Ret As Long
    Ret = EnumWindows(AddressOf hogehoge, 0)

    Debug.Print Time
End Sub

Function hogehoge(ByVal hwnd As Long) As Long
    Debug.Print hwnd
End Function

呼び出される関数名をhogehgoeにしてみたので
AddressOf hogehogeとしています。
第二引数は、hogehoge内のデフォルトの値だと
思うのですが何を指定しても変化がないようです…


さて、F8で一つずつ実行していくとEnumWindows関数が一つ目のハンドルを見つけて
hogehoge関数を呼びだし、ハンドルを引数に渡しているのがわかると思います。
その結果、デバッグプリントしています。
ただし、その後関数を抜けるとエラーとなります。

ハンドルを見つけて呼び出した関数の戻り値が１でない限り
エラーを吐いて終了するからです。

では、エラー処理を追加してみます。
まだまだ問題あり。

view plainprint?

1. Option Explicit  
2.   
3. Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, lParam As Long) As Long  
4. Sub SampleCode()  
5.     On Error Resume Next 'エラーがあっても止めない  
6.     Dim Ret As Long  
7.     Ret = EnumWindows(AddressOf hogehoge, 0)  
8.     On Error GoTo 0 '問題の部分を過ぎたのでエラー処理をもとに戻す  
9.     Debug.Print Time  
10. End Sub  
11.   
12. Function hogehoge(ByVal hwnd As Long) As Long  
13.     Debug.Print hwnd  
14. End Function  

Option Explicit

Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, lParam As Long) As Long
Sub SampleCode()
    On Error Resume Next 'エラーがあっても止めない
    Dim Ret As Long
    Ret = EnumWindows(AddressOf hogehoge, 0)
    On Error GoTo 0 '問題の部分を過ぎたのでエラー処理をもとに戻す
    Debug.Print Time
End Sub

Function hogehoge(ByVal hwnd As Long) As Long
    Debug.Print hwnd
End Function

今度は、一つのハンドルをデバッグプリントした後
エラー処理をしているので、正しく処理が流れています。

ただ、電卓アプリを立ち上げていた時そのハンドルを取得したい
といった場合、該当するアプリのハンドルを見つけるまでは
次々ハンドルを見つけないといけないのでhogehoge関数は
戻り値として1を返すことにしましょう。

view plainprint?

1. Option Explicit  
2.   
3. Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, lParam As Long) As Long  
4. Sub SampleCode()  
5.     '必ずエラーになるので止まらないよう処理しておく  
6.     On Error Resume Next   
7.     Dim Ret As Long  
8.     Ret = EnumWindows(AddressOf hogehoge, 0)  
9.     On Error GoTo 0 '問題の部分を過ぎたのでエラー処理をもとに戻す  
10.     Debug.Print Time  
11. End Sub  
12.   
13. Function hogehoge(ByVal hwnd As Long) As Long  
14.     hogehoge = 1  
15.     Debug.Print hwnd  
16. End Function  

Option Explicit

Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, lParam As Long) As Long
Sub SampleCode()
    '必ずエラーになるので止まらないよう処理しておく
    On Error Resume Next 
    Dim Ret As Long
    Ret = EnumWindows(AddressOf hogehoge, 0)
    On Error GoTo 0 '問題の部分を過ぎたのでエラー処理をもとに戻す
    Debug.Print Time
End Sub

Function hogehoge(ByVal hwnd As Long) As Long
    hogehoge = 1
    Debug.Print hwnd
End Function

これでトップレベルにあるウィンドウのハンドルを全て
デバッグプリントすることができるようになりました。

ただし、ハンドル(数字)の羅列のみだと目的のウィンドウのハンドルがどれかわからないので
ハンドルを元にウィンドウのタイトル名を探すことをしないといけません。
処理を追加します。

view plainprint?

1. Option Explicit  
2.   
3. Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, lParam As Long) As Long  
4.   
5. Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _  
6.     (ByVal hWnd As Long, ByVal MSG As Long, _  
7.      ByVal wParam As Long, ByVal lParam As Long) As Long  
8.   
9. Declare Function SendMessageStr Lib "user32.dll" Alias "SendMessageA" _  
10.     (ByVal hWnd As Long, ByVal MSG As Long, _  
11.      ByVal wParam As Long, ByVal lParam As String) As Long  
12. Const WM_GETTEXT = &HD  
13. Const WM_GETTEXTLENGTH = &HE  
14.   
15. Sub SampleCode()  
16.     '必ずエラーになるので止まらないよう処理しておく  
17.     On Error Resume Next  
18.     Dim Ret As Long  
19.     Ret = EnumWindows(AddressOf EnumWindowsProc, 0)  
20.     On Error GoTo 0 '問題の部分を過ぎたのでエラー処理をもとに戻す  
21.     Debug.Print Time  
22. End Sub  
23.   
24. Function EnumWindowsProc(ByVal hWnd As Long) As Long  
25.     EnumWindowsProc = 1  
26.       
27.     'ハンドルに該当する文字列数を取得(注：Null文字は含まない)  
28.     Dim length As Integer  
29.     length = SendMessageStr(hWnd, WM_GETTEXTLENGTH, 0, 0)  
30.     length = length + 1 'Null文字分１つ増やす  
31.       
32.     Dim str As String  
33.     str = String(length, vbNullChar) 'Null文字分一つ多く領域を確保  
34.       
35.     Dim Ret As Integer  
36.     Ret = SendMessageStr(hWnd, WM_GETTEXT, length, str) 'Null文字も含め受取る  
37.       
38.     '文字列を出力(NULL文字分１つ削って出力)  
39.     Debug.Print Left(str, Len(str) - 1)  
40. End Function  

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 SampleCode()
    '必ずエラーになるので止まらないよう処理しておく
    On Error Resume Next
    Dim Ret As Long
    Ret = EnumWindows(AddressOf EnumWindowsProc, 0)
    On Error GoTo 0 '問題の部分を過ぎたのでエラー処理をもとに戻す
    Debug.Print Time
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文字も含め受取る
    
    '文字列を出力(NULL文字分１つ削って出力)
    Debug.Print Left(str, Len(str) - 1)
End Function

ちなみに、hogehogeからEnumWIndowsProcに名前を変えました。
特に意味はないです…

文字を出力する関係で
SendMessage/SendMessageStr/WM_GETTEXT/WM_GETTEXTLENGTHを追加しました。

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