This code uses the EnumChildWindows API function to create a list of application windows in a hierarchical layout of parent and child windows in Excel.
EnumChildWindows function
Enumerates the child windows that belong to the specified parent window by passing the handle to each child window, in turn, to an application-defined callback function. EnumChildWindows continues until the last child window is enumerated or the callback function returns FALSE.
In the code below the main procedure loops through each application window and calls EnumChildWindows, specifying a callback function, EnumChildWindowsCallback, which receives the child window handles. The problem is that successive calls to EnumChildWindowsCallback, made by Windows, don't maintain context (like a call stack) and therefore we don't know which parent the current child belongs to. Without this information we can't produce a hierarchical layout of parent and child windows.
My solution is to implement a stack (using a VBA Collection and classes) which stores the parent and child windows hierarchy between calls to EnumChildWindowsCallback. Each stack item contains the baseCell and rowOffset of a window so that the code knows where to write that window's details on the sheet. A pointer to the stack is passed as the lParam argument to the EnumChildWindows API and therefore all variables are local.
I know a hierarchical layout could also be produced by a recursive function which calls GetWindow(hWnd, GW_CHILD) and GetWindow(hWnd, GW_NEXT), however I wanted to do it with EnumChildWindows as a learning exercise and because I've never seen it done before.
Standard module:
Class module named cStack:
Class module named cStackItem:
EnumChildWindows function (winuser.h) - Win32 apps
Enumerates the child windows that belong to the specified parent window by passing the handle to each child window, in turn, to an application-defined callback function.
docs.microsoft.com
Enumerates the child windows that belong to the specified parent window by passing the handle to each child window, in turn, to an application-defined callback function. EnumChildWindows continues until the last child window is enumerated or the callback function returns FALSE.
In the code below the main procedure loops through each application window and calls EnumChildWindows, specifying a callback function, EnumChildWindowsCallback, which receives the child window handles. The problem is that successive calls to EnumChildWindowsCallback, made by Windows, don't maintain context (like a call stack) and therefore we don't know which parent the current child belongs to. Without this information we can't produce a hierarchical layout of parent and child windows.
My solution is to implement a stack (using a VBA Collection and classes) which stores the parent and child windows hierarchy between calls to EnumChildWindowsCallback. Each stack item contains the baseCell and rowOffset of a window so that the code knows where to write that window's details on the sheet. A pointer to the stack is passed as the lParam argument to the EnumChildWindows API and therefore all variables are local.
I know a hierarchical layout could also be produced by a recursive function which calls GetWindow(hWnd, GW_CHILD) and GetWindow(hWnd, GW_NEXT), however I wanted to do it with EnumChildWindows as a learning exercise and because I've never seen it done before.
Standard module:
VBA Code:
'Standard module, e.g. Module1
Option Explicit
#If VBA7 Then
Public Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
Public Declare PtrSafe Function GetWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal wCmd As Long) As LongPtr
Public Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As LongPtr) As Long
Public Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare PtrSafe Function EnumChildWindows Lib "user32" (ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
Public Declare PtrSafe Function GetParent Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Public Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hWnd As LongPtr) As Long
#Else
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long
#End If
Public Const GW_NEXT = 2
Public Const GW_CHILD = 5
Public Sub List_Desktop_Windows()
#If VBA7 Then
Dim hWndDesktop As LongPtr, hWnd As LongPtr
#Else
Dim hWndDesktop As Long, hWnd As Long
#End If
Dim startCell As Range
Dim numRows As Long
Dim lngLength As Long
Dim strBuffer As String
Dim lngRet As Long
Dim thisWindowTitle As String, thisWindowClass
Dim stack As cStack
Dim stackItem As cStackItem
hWndDesktop = GetDesktopWindow
With Worksheets(1)
.Activate
.Cells.Clear
.Range("A1:D1").Value = Split("Parent,Window,Title,Class", ",")
Set startCell = .Range("A2")
numRows = 0
End With
'Create stack to save parent and child window hierarchy between callbacks to EnumChildWindows procedure
Set stack = New cStack
hWnd = GetWindow(hWndDesktop, GW_CHILD)
Do While hWnd <> 0
lngLength = GetWindowTextLength(hWnd) + 1
strBuffer = Space(lngLength)
lngRet = GetWindowText(hWnd, strBuffer, lngLength)
thisWindowTitle = Left(strBuffer, lngLength - 1)
strBuffer = String$(256, Chr$(0))
lngRet = GetClassName(hWnd, strBuffer, Len(strBuffer))
thisWindowClass = Left$(strBuffer, lngRet)
If thisWindowTitle <> "" And IsWindowVisible(hWnd) Then
'Found a desktop application window so put it on the empty stack
Set stackItem = New cStackItem
With stackItem
Set .baseCell = startCell.Offset(numRows)
.rowOffset = 0
.hWndParent = hWnd
End With
stack.Push stackItem
With stackItem.baseCell
.Offset(, 0).Value = "0x" & Hex(GetParent(hWnd))
.Offset(, 1).Value = "0x" & Hex(hWnd)
.Offset(, 2).Value = thisWindowTitle
.Offset(, 3).Value = thisWindowClass
End With
'Enumerate all child windows and output to Excel cells in a hierarchical layout
EnumChildWindows hWnd, AddressOf EnumChildWindowsCallback, VarPtr(stack)
'Pop all stack items (emptying the stack) to calculate the total number of rows written for this application window and its child windows
While stack.Count > 0
Set stackItem = stack.Pop
numRows = numRows + stackItem.rowOffset
Wend
numRows = numRows + 2 '+2 to give 1 row gap between application windows
With startCell.Offset(numRows - 1).Resize(, 4).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
hWnd = GetWindow(hWnd, GW_NEXT)
Loop
End Sub
#If VBA7 Then
Public Function EnumChildWindowsCallback(ByVal hWnd As LongPtr, stack As cStack) As Long
#Else
Public Function EnumChildWindowsCallback(ByVal hWnd As Long, stack As cStack) As Long
#End If
Dim lngLength As Long
Dim strBuffer As String
Dim lngRet As Long
Dim thisWindowTitle As String, thisWindowClass As String
Dim numChildren As Long
Dim parentItem As cStackItem
Dim childItem As cStackItem
lngLength = GetWindowTextLength(hWnd) + 1
strBuffer = Space(lngLength)
lngRet = GetWindowText(hWnd, strBuffer, lngLength)
thisWindowTitle = Left(strBuffer, lngLength - 1)
strBuffer = String$(256, Chr$(0))
lngRet = GetClassName(hWnd, strBuffer, Len(strBuffer))
thisWindowClass = Left$(strBuffer, lngRet)
'Pop items from stack until this child's parent is found, counting the total number of intervening children
numChildren = 1
Do
Set parentItem = stack.Pop
numChildren = numChildren + parentItem.rowOffset
Loop Until GetParent(hWnd) = parentItem.hWndParent
'Update parent row offset by number of children and put parent back on stack
parentItem.rowOffset = numChildren
stack.Push parentItem
'Put this child window on stack, with its baseCell set to 'n' rows below the parent and 1 column to the right
Set childItem = New cStackItem
With childItem
.rowOffset = 0
Set .baseCell = parentItem.baseCell.Offset(parentItem.rowOffset, 1)
.hWndParent = hWnd
End With
stack.Push childItem
'Write child window details in columns on current row
With childItem.baseCell
.Offset(, 0).Value = "0x" & Hex(GetParent(hWnd))
.Offset(, 1).Value = "0x" & Hex(hWnd)
.Offset(, 2).Value = thisWindowTitle
.Offset(, 3).Value = thisWindowClass
End With
'Continue enumerating child windows
EnumChildWindowsCallback = 1
End Function
Class module named cStack:
VBA Code:
'Class module cStack
'Uses a VBA Collection as the stack data structure
Option Explicit
Dim pStack As Collection
Private Sub Class_Initialize()
Set pStack = New Collection
End Sub
Private Sub Class_Terminate()
Set pStack = Nothing
End Sub
Public Function Push(newItem As cStackItem) As cStackItem
With pStack
.Add newItem
Set Push = .Item(.Count)
End With
End Function
Public Function Pop() As cStackItem
With pStack
If .Count > 0 Then
Set Pop = .Item(.Count)
.Remove .Count
End If
End With
End Function
Public Function Count() As Long
Count = pStack.Count
End Function
Public Sub Dump()
Dim i As Long
Dim stackItem As cStackItem
With pStack
If .Count = 0 Then Debug.Print "Empty"
For i = .Count To 1 Step -1
Set stackItem = .Item(i)
With stackItem
Debug.Print i; .baseCell.Offset(.rowOffset).Address(False, False), Hex(.hWndParent), "Offset " & .rowOffset
End With
Next
End With
End Sub
VBA Code:
'Class module cStackItem
'User-defined type for a stack item
Option Explicit
Public baseCell As Range
Public rowOffset As Long
#If VBA7 Then
Public hWndParent As LongPtr
#Else
Public hWndParent As Long
#End If