ウィンドウの列挙＠VBA

まあ，よくあるけどメモのため。
それとobjptr始めて使ったけど，スゲーあっさりコールバック関数内でコレクションが使えてしまった（汗
何も考えずByVal lParam as Objectで受け取っただけなんだけど。。。

あと，固定文字列使うとRTrimして再代入すると末尾の空白が復活する罠。
どうなん，この挙動。。。まあ，string関数使えばいいだけだけどさ。。。

Option Explicit

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal cnm As String, ByVal cap As String) As Long
Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, _
                                                                    ByVal cch As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, _
                                                                  ByVal nMaxCount As Long) As Long
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, _
                                                ByVal lParam As Long) As Long
Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
Const INDENT_KEY = "INDENT"

Public Function EnumChildWindowsProc(ByVal hWnd As Long, ByVal lParam As Object) As Long
    EnumChildWindowsProc = EnumWindowsProc(hWnd, lParam)
End Function

Public Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Object) As Long
    EnumWindowsProc = True
    
    If IsWindowVisible(hWnd) = 0 Then
        Exit Function
    End If

    Dim strClassName As String ' * 255
    Dim strCaption As String ' * 255
    strClassName = String(255, vbNullChar)
    strCaption = String(255, vbNullChar)
    
    GetWindowText hWnd, strCaption, Len(strCaption)
    GetClassName hWnd, strClassName, Len(strClassName)
    strCaption = RTrim(left(strCaption, InStr(1, strCaption, vbNullChar) - 1))
    strClassName = RTrim(left(strClassName, InStr(1, strClassName, vbNullChar) - 1))
    
    ActiveCell.Cells(1, 1).Value = Hex(hWnd)
    ActiveCell.Cells(1, 2).Value = IsWindowVisible(hWnd)
    ActiveCell.Cells(1, 3).Value = strCaption
    ActiveCell.Cells(1, 4).Value = strClassName
    ActiveCell.Cells(2, 2).Activate
    
    Dim c As Collection
    Set c = lParam
        
    Dim indent As Long
    indent = c(INDENT_KEY)
    c.Add String(indent * 2, " ") & Hex(hWnd) & "  " & strCaption & "  " & strClassName, before:=c.Count
    
    indent = indent + 1
    c.Remove INDENT_KEY
    c.Add indent, INDENT_KEY
    
    Call EnumChildWindows(hWnd, AddressOf EnumChildWindowsProc, ObjPtr(c))
    
    indent = c(INDENT_KEY) - 1
    c.Remove INDENT_KEY
    c.Add indent, INDENT_KEY

    ActiveCell.Cells(1, 0).Activate

End Function

Sub hoge()
    Application.ScreenUpdating = False
    
    Dim sht As Worksheet
    Set sht = ThisWorkbook.Worksheets(1)
    sht.UsedRange.Clear
    sht.Activate
    sht.Range("A1").Activate
    
    Dim c As Collection
    Set c = New Collection
    c.Add 0, INDENT_KEY
    
    Dim ret As Long
    ret = EnumWindows(AddressOf EnumWindowsProc, ObjPtr(c))
    
    c.Remove INDENT_KEY
    
    Set sht = ThisWorkbook.Worksheets(2)
    sht.UsedRange.Clear
    sht.Activate
    sht.Range("A1").Activate
    
    Dim o As Variant
    For Each o In c
        ActiveCell.Value = o
        ActiveCell.Cells(2, 1).Activate
    Next
    
    Application.ScreenUpdating = True

End Sub