Code:
' Original main Code Courtesy of Dev Ashish http://access.mvps.org/access/api/api0013.htm and https://eileenslounge.com/viewtopic.php?p=321978#p321978
'
Private Declare Function apiGetClassName Lib "user32" Alias "GetClassNameA" (ByVal Hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function apiGetDesktopWindow Lib "user32" Alias "GetDesktopWindow" () As Long
Private Declare Function apiGetWindow Lib "user32" Alias "GetWindow" (ByVal Hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function apiGetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function apiGetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal Hwnd As Long, ByVal lpString As String, ByVal aint As Long) As Long
Private Declare Function FindWndNumber Lib "user32" Alias "FindWindowA" (Optional ByVal lpClassName As String, Optional ByVal lpWindowName As String) As Long
Private Const mcGWCHILD = 5
Private Const mcGWHWNDNEXT = 2
Private Const mcGWLSTYLE = (-16)
Private Const mcWSVISIBLE = &H10000000 ' Watch window gives 268435456 (even when no code is running)
Private Const mconMAXLEN = 255
Public Sub fEnumWindows()
' For worksheet output, not important for understanding the main coding
Dim Ws As Worksheet: Set Ws = ThisWorkbook.Worksheets.Item(1)
Dim Lc As Long, Lr As Long: Let Lc = Ws.Cells.Item(2, Ws.Columns.Count).End(xlToLeft).Column
Let Ws.Cells.Item(1, Lc + 1) = CreateObject("WScript.Network").ComputerName & " " & Format(Now(), "ddd,dd,mmm,yyyy") ' Environ$("computername") Nigel Heffernan https://stackoverflow.com/questions/3551055/how-to-get-name-of-the-computer-in-vba/10108951#10108951
Let Ws.Cells.Item(2, Lc + 1) = "Hwnd": Let Ws.Cells.Item(2, Lc + 2) = "Class Name": Let Ws.Cells.Item(2, Lc + 3) = "Caption": Let Ws.Cells.Item(2, Lc + 4) = "Hwnd( Caption)": Let Ws.Cells.Item(2, Lc + 5) = "enum visible?"
Dim lngx As Long, lngLen As Long, lngStyle As Long, strCaption As String
Let lngx = apiGetDesktopWindow(): Debug.Print "Geted Desktop Window " & lngx & " " & " CLass name " & fGetClassName(lngx)
Let lngx = apiGetWindow(lngx, mcGWCHILD): Debug.Print " First child to Desktop " & lngx & " CLass name " & fGetClassName(lngx) ' GW_CHILD = 5 The topmost of the given window's child windows. This has the same effect as using the GetTopWindow function, ... usually at the top of all the other children in the Z-order
Do While Not lngx = 0 ' We are looping "equal level children", seperated not realy, just look seperate to us because of the seen to us z order
Let strCaption = fGetCaption(lngx)
' If Len(strCaption) > 0 Then ' Those without a caption seem not important
Let lngStyle = apiGetWindowLong(lngx, mcGWLSTYLE) ' apiGetWindowLong gets info, GWL_STYLE -16 retrieves the window styles
' For enum visible windows only
' If lngStyle And mcWSVISIBLE Then '
Let Lr = Ws.Cells.Item(Ws.Rows.Count, Lc + 1).End(xlUp).Row ' Handle Class name Caption
If lngStyle And mcWSVISIBLE Then
Let Ws.Cells.Item(Lr + 1, Lc + 5) = "enum visible " & lngStyle & " And " & mcWSVISIBLE
Else
'Let Ws.Cells.Item(Lr + 1, Lc + 5) = lngStyle & " And " & mcWSVISIBLE
End If
Let Ws.Cells.Item(Lr + 1, Lc + 6) = lngStyle: Ws.Cells.Item(Lr + 1, Lc + 7) = mcWSVISIBLE
Debug.Print FindWndNumber(lpClassName:=fGetClassName(lngx), lpWindowName:=vbNullString), fGetClassName(lngx); Tab(50); fGetCaption(lngx); Tab(100); FindWndNumber(lpClassName:=vbNullString, lpWindowName:=fGetCaption(lngx))
Let Ws.Cells.Item(Lr + 1, Lc + 1) = lngStyle & " " & FindWndNumber(lpClassName:=fGetClassName(lngx)): Let Ws.Cells.Item(Lr + 1, Lc + 2) = fGetClassName(lngx): Let Ws.Cells.Item(Lr + 1, Lc + 3) = fGetCaption(lngx): Let Ws.Cells.Item(Lr + 1, Lc + 4) = FindWndNumber(lpClassName:=vbNullString, lpWindowName:=fGetCaption(lngx))
' End If
' End If
Let lngx = apiGetWindow(lngx, mcGWHWNDNEXT) ' GW_HWNDNEXT = 2 The window below the given window in the Z-order.
Loop ' While Not lngx = 0 ' I am going through all the child windows of the desktop windows
End Sub
Private Function fGetCaption(Hwnd As Long) As String
Dim strBuffer As String, intCount As Integer
Let strBuffer = String$(Number:=255 - 1, Character:="0") ' "00000000000000000000000000000000..........000"
Let intCount = apiGetWindowText(Hwnd:=Hwnd, lpString:=strBuffer, aint:=255) ' This makes strBuffer something like *MSCTFIME UI 0000000000000000............000"
If intCount > 0 Then Let fGetCaption = Left$(strBuffer, intCount)
End Function
Private Function fGetClassName(Hwnd As Long) As String
Dim strBuffer As String, intCount As Integer
Let strBuffer = String$(255 - 1, 0)
Let intCount = apiGetClassName(Hwnd, strBuffer, mconMAXLEN)
If intCount > 0 Then
Let fGetClassName = Left$(strBuffer, intCount)
End If
End Function
Reply With Quote
Bookmarks