見出し画像

【VBA】全てのウィンドウ情報を羅列するコード

地獄の油揚げ

全てのウィンドウ情報（以下）をシートへ書き出すVBAコードです。
・キャプション名
・クラス名
・ハンドル
・プロセスID
・プロセス名
・（参考）親ウィンドウのキャプション名
・（参考）親ウィンドウのクラス名
・（参考）親ウィンドウのハンドル

【実行結果の例】

現在PCで開いているウィンドウ情報一覧を書き出す

こんな感じでシートへ書き出します。
どうしてもウィンドウハンドルを特定したいダイアログがあったので、必要に迫られて作ったものです。
プロセス名からも追いかけられるので、何かと便利。

コードはこちら。

'ウィンドウ情報（キャプション・クラス・ハンドル・プロセス）取得用API
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal IpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As LongPtr) As LongPtr
Private Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hWnd As LongPtr, ByVal wFlag As LongPtr) As LongPtr
Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As LongPtr, ByRef lpdwProcessId As LongPtr) As LongPtr
Private Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As LongPtr) As LongPtr
Private Declare PtrSafe Function QueryFullProcessImageName Lib "kernel32" Alias "QueryFullProcessImageNameA" (ByVal hProcess As LongPtr, ByVal dwFlags As Long, ByVal lpExeName As String, ByRef lpdwSize As Long) As Long
Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function GetParent Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const GW_HWNDNEXT = &H2
'------------------------

Private Sub GetWindowInfo()
    Dim inData() As Variant
    Dim Num As Long
    Num = 0
    ReDim inData(10, Num + 1)
    inData(0, 0) = "可視/" & vbCrLf & "不可視"
    inData(1, 0) = "キャプション名"
    inData(2, 0) = "クラス名"
    inData(3, 0) = "ウィンドウ" & vbCrLf & "ハンドル"
    inData(4, 0) = "プロセスID"
    inData(5, 0) = "プロセス名"
    inData(6, 0) = "親ウィンドウ" & vbCrLf & "の有無"
    inData(7, 0) = "(参考)" & vbCrLf & "親キャプション名"
    inData(8, 0) = "(参考)" & vbCrLf & "親クラス"
    inData(9, 0) = "(参考)" & vbCrLf & "親ハンドル"

    Dim hWnd As LongPtr
    Dim strCaption As String * 80
    Dim strClassName As String * 255
    Dim pId As LongPtr
    Dim hProcess As LongPtr
    Dim lpExeName As String * 255
    Dim lpdwSize As Long
    Dim ret As Long
    Dim P_hWnd As LongPtr
    hWnd = FindWindow(vbNullString, vbNullString)
    Do
        Num = Num + 1
        ReDim Preserve inData(10, Num + 1)
        '可視/不可視
        If IsWindowVisible(hWnd) <> 0 Then
            inData(0, Num) = "〇"
        Else
            inData(0, Num) = "×"
        End If
        'キャプション名
        GetWindowText hWnd, strCaption, Len(strCaption)
        inData(1, Num) = Left(strCaption, InStr(strCaption, vbNullChar) - 1)
        'クラス名
        GetClassName hWnd, strClassName, Len(strClassName)
        inData(2, Num) = Left(strClassName, InStr(strClassName, vbNullChar) - 1)
        'ハンドル
        inData(3, Num) = hWnd
        'プロセスID
        GetWindowThreadProcessId hWnd, pId
        inData(4, Num) = pId
        'プロセス名
        hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, pId)
        If hProcess <> 0 Then
            lpdwSize = Len(lpExeName)
            ret = QueryFullProcessImageName(hProcess, 0, lpExeName, lpdwSize)
            If ret <> 0 Then
                inData(5, Num) = lpExeName
            End If
            CloseHandle hProcess
        End If
        '(参考)親ウィンドウの有無を確認
        P_hWnd = GetParent(hWnd)
        If P_hWnd = 0 Then
            inData(6, Num) = "-"
            inData(7, Num) = "-"
            inData(8, Num) = "-"
            inData(9, Num) = "-"
        Else
            inData(6, Num) = "〇"
            '(参考)親キャプション名"
            GetWindowText P_hWnd, strCaption, Len(strCaption)
            inData(7, Num) = Left(strCaption, InStr(strCaption, vbNullChar) - 1)
            '(参考)親クラス名
            GetClassName P_hWnd, strClassName, Len(strClassName)
            inData(8, Num) = Left(strClassName, InStr(strClassName, vbNullChar) - 1)
            '(参考)親ハンドル
            inData(9, Num) = P_hWnd
        End If
        hWnd = GetNextWindow(hWnd, GW_HWNDNEXT)
    Loop Until hWnd = 0
    
    Dim sh As Worksheet
    Set sh = ActiveSheet
    sh.Cells.Clear
    With sh.Range("A1")
        'データ貼付け
        .Resize(UBound(inData, 2), UBound(inData)).Value = Application.WorksheetFunction.Transpose(inData)
        .Resize(UBound(inData, 2), UBound(inData)).Borders.LineStyle = xlContinuous
        '見出し行を設定
        .Resize(, 10).Columns.AutoFit
        .Resize(, 10).HorizontalAlignment = xlCenter
        .Resize(, 10).Interior.Color = RGB(217, 217, 217) 'グレー
        .Resize(, 10).AutoFilter
        '体裁を整える
        Columns(.Column).HorizontalAlignment = xlCenter
        Columns(.Offset(, 6).Column).HorizontalAlignment = xlCenter
        Columns(.Offset(, 9).Column).HorizontalAlignment = xlRight
        .Offset(, 1).Resize(, 2).ColumnWidth = 20
        .Offset(, 5).ColumnWidth = 20
        .Offset(, 7).Resize(, 2).ColumnWidth = 20
    End With
End Sub

通常、ウィンドウ情報を調べるには「Spy++」など専用ソフトウェアを介して調査する場合が多いと思いますが、職場環境（会社PC）ではインストールが許可されていないことも考えられます。
なので、Excel上でサクッと動作するコレが意外と重宝したりします。
キャプション名、クラス名、プロセス名を一緒に書き出しているので、「このウィンドウ情報って何だろう？」と思うことがあれば、これら項目名から引っかけて大体特定できます。
意外と出番が多いコードかもしれません。

もしこれでも調査対象のウィンドウが見つからない場合、更に深い階層に隠れている可能性が考えられます。
上記コードで親ウィンドウに目星をつけた上で、EnumChildWindows関数にそのウィンドウハンドルを渡すことで子階層を更に調査出来ます。
こんな感じでEnumChildWindows関数を呼び出すプロシージャと、コールバック関数を書いたプロシージャを用意してやればOK。
イミディエイトウィンドウに子階層のウィンドウ情報が書き出されます。

Private Declare PtrSafe Function EnumChildWindows Lib "user32.dll" (ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, lParam As Long) As Long
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As LongPtr) As LongPtr
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As LongPtr) As LongPtr

Private Sub Sample()
　Dim hWnd As LongPtr
　hWnd = 目星をつけたウィンドウハンドルを代入
　EnumChildWindows hWnd, AddressOf EnumChildProc, 0 'コールバック関数へ
End Sub

'受取ったハンドルの子ウィンドウを順次調査するコールバック関数
Private Function EnumChildProc(ByVal hWndZ As LongPtr, ByVal lParam As Long) As Long
  Dim strClassName As String * 255
  Dim ClassName As String
  GetClassName hWndZ, strClassName, Len(strClassName)
  ClassName = Left(strClassName, InStr(strClassName, vbNullChar) - 1)
  Debug.Print "クラス名= " & ClassName
 
  Dim strCaption As String * 80
  Dim CaptionName As String
  GetWindowText hWndZ, strCaption, Len(strCaption)
  CaptionName = Left(strCaption, InStr(strCaption, vbNullChar) - 1)
  Debug.Print "キャプション名= " & CaptionName
  Debug.Print "ウィンドウハンドル= " & hWndZ
  Debug.Print "-----"

  '目的のクラス名が見つかったらコールバック関数を脱出
  'If ClassName = "目的のクラス名" Then
  '  EnumChildProc = 0
  '  Exit Function
  'End If
  EnumChildProc = 1 '継続して列挙するために1を返す
End Function

この記事が気に入ったらサポートをしてみませんか？