VBA Excel as ActiveWindow Screenshot recorder

I was on the need to get screenshots of a lot of userforms from an application. I was not for the option of capture the image, save the image with name, go again… so here is a window capturer for the active window or for the full screen. It may be not the best option, but items can be done inside Excel.

#If VBA7 Then
    Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#Else
    Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#End If

Private Const VK_SNAPSHOT = &H2C
Private Const VK_MENU = &H12
Private Const KEYEVENTF_KEYUP = &H2

Private Sub sPrintScreen()
' To capture the screen
    keybd_event VK_SNAPSHOT, 1, 0, 0
End Sub

Private Sub sAltPrintScreen()
' To capture the active window
    Application.Wait VBA.Now() + TimeSerial(0, 0, 5)
    
    keybd_event VK_MENU, 0, 0, 0
    keybd_event VK_SNAPSHOT, 0, 0, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
    keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0

    Application.Wait VBA.Now() + TimeSerial(0, 0, 1)
    
    ' Add a new worksheet to paste image
    Dim oXlWsh As Excel.Worksheet
    Dim oXlShp As Excel.Shape
    Dim sgLeft As Single
    Dim sgTop As Single
    Dim sgWidth As Single
    Dim sgHeight As Single
    Dim oCht As Excel.Chart
    Dim oChtObj As Excel.ChartObject
    
    Set oXlWsh = ThisWorkbook.Worksheets.Add 'ActiveSheet
    With oXlWsh
        '.Name = ...
        .Range("A1").Select
        .Paste
        
        ' Save image to file
        Set oXlShp = .Shapes(.Shapes.Count)
    
        With oXlShp
            ' Copy the picture
            .Copy
            '.CopyPicture
            
            '' To Resize
            '.Height = 600
            '.Width = 800
        
            '' To Position It: use the shape's TopLeftCell property.
            
            '' To Crop It: use the shp.PictureFormat.Crop (and/or CropLeft, CropTop, CropBottom, CropRight)
            '' if you need to fine-tune what part of the screenshot is needed.
            '' For instance, this crops the pasted screenshot to 800x600:
            'sgHeight = -(600 - .Height)
            'sgWidth = -(800 - .Width)
            
            '.LockAspectRatio = False
            '.PictureFormat.CropRight = sgWidth
            '.PictureFormat.CropBottom = sgHeight
        
            ' Save image
            'Set oCht = ThisWorkbook.Charts.Add
            'oCht.Location Where:=xlLocationAsObject, Name:=.Name
            
            Set oChtObj = oXlWsh.ChartObjects.Add(0, 0, .Width, .Height)
            With oChtObj
                .Border.LineStyle = 0
                .Left = oXlShp.Left
                .Width = oXlShp.Width
                .Top = oXlShp.Top
                .Height = oXlShp.Height
            
                'To save a range: oRng.CopyPicture xlScreen, xlPicture 'or xlPicture --> xlBitmap
                With .Chart
                    .Paste
                    .Export Filename:=VBA.Environ$("UserProfile") & "\Documents\SavedRange.jpg", FilterName:="JPG"
                End With
                
                DoEvents
                .Delete ' get rid of the chart
            End With
            
            '.Delete ' get rid of the image
        End With
        
        ' Other options to save the JPG
        'https://www.tek-tips.com/viewthread.cfm?qid=1764114
        'http://www.mvps.org/emorcillo/en/code/vb6/index.shtml
        
        
        ' Delete worksheet
        'Application.DisplayAlerts = False
        '.Delete
        'Application.DisplayAlerts = True
    End With
End Sub

From there on I can, for example, get the controls in that window (following the idea in this enlightning post from Xristos Samaras’s MyEngineeringWorld).

Option Explicit
  
'Declaring the necessary API functions for both 64 and 32 bit applications.
#If VBA7 And Win64 Then
'For 64 bit applications.
    'Performs an operation on a specified file.
    Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
    
    'Retrieves a handle to the top-level window whose class name and window name match the specified strings.
    'This function does not search child windows. This function does not perform a case-sensitive search.
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
            
    'Retrieves a handle to a window whose class name and window name match the specified strings.
    'The function searches child windows, beginning with the one following the specified child window.
    'This function does not perform a case-sensitive search.
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
       
    'Sends the specified message to a window or windows. The SendMessage function calls the window procedure
    'for the specified window and does not parentWindowurn until the window procedure has processed the message.
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
        
    'Places (posts) a message in the message queue associated with the thread that created the specified
    'window and parentWindowurns without waiting for the thread to process the message.
    Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    
    Private Declare PtrSafe Function GetForegroundWindow Lib "user32.dll" () As LongPtr
    Private Declare PtrSafe Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" (ByVal hWnd 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 Long
    Private Declare PtrSafe Function EnumChildWindows Lib "user32.dll" (ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
    Private Declare PtrSafe Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Boolean
    
    Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As LongPtr
    
    'Private Declare PtrSafe Function GetTopWindow Lib "user32.dll" (ByVal hWnd As LongPtr) As LongPtr
    'Private Declare PtrSafe Function GetNextWindow Lib "user32.dll" Alias "GetWindow" (ByVal hWnd As LongPtr, ByVal wFlag As LongPtr) As LongPtr
    'Private Declare PtrSafe Function IsWindowVisible Lib "user32.dll" (ByVal hWnd As LongPtr) As LongPtr
#Else
'For 32 bit applications.
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
                                                        
    Private Declare Function GetForegroundWindow Lib "user32" () As Long
    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
    Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long

    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function EnumChildWindows Lib "user32.dll" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
    Private Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Boolean
    
    Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
#End If
     
Private Const ERROR_INVALID_WINDOW_HANDLE As Long = 1400
Private Const ERROR_INVALID_WINDOW_HANDLE_DESCR As String = "Invalid window handle."

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

' Windows API Constants --> https://doc.pcsoft.fr/en-US/?6510001&verdisp=160  &  https://www.magnumdb.com/
Private Const SW_HIDE As Long = 0
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWMINIMIZED As Long = 2
Private Const VK_RETURN As Long = &HD
Private Const WM_SETTEXT As Long = &HC
Private Const WM_KEYDOWN As Long = &H100
Private Const WM_KEYUP As Long = &H101
Private Const WM_LBUTTONDOWN As Long = 513
Private Const WM_LBUTTONUP As Long = 514
Private Const WM_LBUTTONDBLCLK As Long = 515
Private Const WM_RBUTTONDOWN As Long = 516
Private Const WM_RBUTTONUP As Long = 517
Private Const WM_RBUTTONDBLCLK As Long = 518
Private Const WM_MBUTTONDOWN As Long = 519
Private Const WM_MBUTTONUP As Long = 520
Private Const WM_MBUTTONDBLCLK As Long = 521
Private Const WS_TABSTOP As Long = 65536
Private Const WM_CLOSE As Long = &H10
Private Const BM_CLICK As Long = &HF5

#If VBA7 And Win64 Then
    Private hWnd As LongPtr
    Private CtrlHandle As LongPtr
#Else
    Private hWnd As Long
    Private CtrlHandle As Long
#End If

 'Used a user defined type here rather than Enum so that it works on 97
Private Type winEnum
    winHandle As Integer
    winClass As Integer
    winTitle As Integer
    winHandleClass As Integer
    winHandleTitle As Integer
    winHandleClassTitle As Integer
End Type

Private winOutputType As winEnum
Private x As Integer
 
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

#If VBA7 And Win64 Then
    Private Type tHandle
        hWnd As LongPtr
        Name As String
        ClassName As String
    End Type
#Else
    Private Type tHandle
        hWnd As Long
        Name As String
        ClassName As String
    End Type
#End If

Private aChild() As tHandle
Private winNum As Long

#If VBA7 And Win64 Then
    Private Sub Test()
    ' You can't call this on a button click, because then your window will be the foreground window.
    ' Add a timer/wait
    ' Run the procedure, click another window within 5 seconds.
        Dim hWnd As LongPtr
        
        Dim strTitle As String
        Dim strClassName As String
        Dim lgClassNameLength As LongPtr
        Dim lgRetVal As Long
    
        MsgBox "Go activate the Window you want to Spy"
        Application.Wait VBA.Now() + TimeSerial(0, 0, 5)
        
        ' If no handle, get active window
        If hWnd = 0 Then hWnd = hWnd = GetForegroundWindow()
        
        strTitle = fWindowTitle(hWnd)
        strClassName = fWindowClassName(hWnd)
    
        ''https://stackoverflow.com/questions/6310731/window-click-ok-button-by-code
        Erase aChild(): winNum = 0
        lgRetVal = EnumChildWindows(hWnd, AddressOf EnumChildProc, 0)
    
Stop
'        For lgChild = LBound(aChild) To UBound(aChild)
'        Next lgChild
Stop
'        ' the Button's Caption is "Open" and it is a "Button".
'        CtrlHandle = FindWindowEx(hWnd, 0, "Button", "&Open")
        
'        ' send Click to the button(CtrlHandle).
'        lgRetVal = SendMessage(CtrlHandle, BM_CLICK, 0, 0)
        
'        'Fill with text the TextBox.
'        lgRetVal = SendMessage(CtrlHandle, WM_SETTEXT, 0&, ByVal strText)
        
'        'Press the OK button (it is the default action, so no need to find the handle of the button).
'        lgRetVal = PostMessage(CtrlHandle, WM_KEYDOWN, VK_RETURN, 0)
    End Sub
    
    Private Function fWindowClassName(ByVal hWnd As LongPrt) As String
        Dim strClassName As String
        Dim lgClassNameLength As LongPtr
        Dim lgRetVal As Long
        
        strClassName = String$(100, Chr$(0))
        lgRetVal = GetClassName(hWnd, strClassName, 100)
        fWindowClassName = VBA.Mid$(strClassName, 1, VBA.InStr(1, strClassName, Chr$(0)) - 1)
    End Function
    
    Private Function fWindowTitle(ByVal hWnd As LongPtr) As String
        Dim strTitle As String
        
'        Dim lgBufferLen As Long
'        Dim wintext As String ' window title text length and buffer
'        Dim lgRetVal As Long  ' return value
'        Dim strBuffer As String
'
'        lgBufferLen = GetWindowTextLength(hWnd) + 1 ' get length of title bar text
'        strBuffer = VBA.Space$(lgBufferLen)  ' make room in the buffer
'        lgRetVal = GetWindowText(hWnd, strBuffer, lgBufferLen)
'        fWindowTitle = VBA.Left$(strBuffer, lgBufferLen - 1)  ' display title bar text of enumerated window
        
        ' If not handle, get the active window
        If hWnd = 0 Then hWnd = GetForegroundWindow()
        
        ' get the title of the active window
        strTitle = VBA.String(GetWindowTextLength(hWnd) + 1, VBA.Chr$(0)) ' Make the buffer
        GetWindowText hWnd, strTitle, Len(strTitle) + 1
    
        fWindowTitle = VBA.Mid$(strTitle, 1, VBA.InStr(1, strTitle, Chr$(0)) - 1)
    End Function
    
    Private Function EnumChildProc(ByVal hWnd As LongPtr, _
                                   ByVal lParam As LongPtr) As Long
        Dim lgRetVal As Long
        
        winNum = winNum + 1
        ReDim Preserve aChild(1 To winNum)
        With aChild(winNum)
            .ClassName = fWindowClassName(hWnd)
            .Name = fWindowTitle(hWnd)
            .hWnd = hWnd
            '.hWnd = FindWindow(.ClassName, .Name)
            'lgRetVal = FindWindowEx(hWnd, 0, .ClassName, .Name)
            'lgRetVal = FindWindowEx(hWnd, .hWnd, vbNullString, vbNullString)
            'lgRetVal = FindWindowEx(hWnd, 0&, vbNullString, vbNullString)
        End With
        
        EnumChildProc = 1  ' nonzero return value means continue enumeration
    End Function
    
    Private Function fWindowRec(ByVal hWnd As LongPtr, _
                                ByRef Top As Long, _
                                ByRef Left As Long, _
                                ByRef Right As Long, _
                                ByRef Bottom As Long, _
                                ByRef Width As Long, _
                                ByRef Height As Long) As Boolean
    ' Get left, right, top, and bottom positions of a window in pixels.
        Dim rectWindow As RECT
         
        ' Pass in window handle and empty the data structure.
        ' If function returns 0, an error occurred.
        If GetWindowRect(hWnd, rectWindow) = 0 Then
        ' Check LastDLLError and display a dialog box if the error
        ' occurred because an invalid handle was passed.
            If Err.LastDllError = ERROR_INVALID_WINDOW_HANDLE Then
                fWindowRec = False
                'MsgBox ERROR_INVALID_WINDOW_HANDLE_DESCR, Title:="Error!"
            End If
        Else
            With rectWindow
                Bottom = .Bottom
                Left = .Left
                Right = .Right
                Top = .Top
                Width = .Right - .Left
                Height = .Bottom - .Top
            End With
            fWindowRec = True
        End If
    End Function

#Else
    Private Sub Test()
    ' You can't call this on a button click, because then your window will be the foreground window.
    ' Add a timer/wait
    ' Run the procedure, click another window within 5 seconds.
        Dim hWnd As Long
        
        Dim strTitle As String
        Dim strClassName As String
        Dim lgClassNameLength As Long
        Dim lgRetVal As Long
        Dim lgChild As Long
        Dim strText As String
    
        MsgBox "Go activate the Window you want to Spy"
        Application.Wait VBA.Now() + TimeSerial(0, 0, 5)
        hWnd = GetForegroundWindow()
        
        strTitle = fWindowTitle(hWnd)
        strClassName = fWindowClassName(hWnd)
    
        ''https://stackoverflow.com/questions/6310731/window-click-ok-button-by-code
        Erase aChild(): winNum = 0
        lgRetVal = EnumChildWindows(hWnd, AddressOf EnumChildProc, 0)
    
Stop
'        For lgChild = LBound(aChild) To UBound(aChild)
'        Next lgChild
Stop
'        ' the Button's Caption is "Open" and it is a "Button".
'        CtrlHandle = FindWindowEx(hWnd, 0, "Button", "&Open")
        
'        ' send Click to the button(CtrlHandle).
'        lgRetVal = SendMessage(CtrlHandle, BM_CLICK, 0, 0)
        
'        'Fill with text the TextBox.
'        lgRetVal = SendMessage(CtrlHandle, WM_SETTEXT, 0&, ByVal strText)
        
'        'Press the OK button (it is the default action, so no need to find the handle of the button).
'        lgRetVal = PostMessage(CtrlHandle, WM_KEYDOWN, VK_RETURN, 0)
    End Sub
    
    Private Function fWindowClassName(ByVal hWnd As Long) As String
        Dim strClassName As String
        Dim lgClassNameLength As Long
        Dim lgRetVal As Long
        
        strClassName = String$(100, Chr$(0))
        lgRetVal = GetClassName(hWnd, strClassName, 100)
        fWindowClassName = VBA.Mid$(strClassName, 1, VBA.InStr(1, strClassName, Chr$(0)) - 1)
    End Function
    
    Private Function fWindowTitle(ByVal hWnd As Long) As String
        Dim strTitle As String
        
'        Dim lgBufferLen As Long
'        Dim wintext As String ' window title text length and buffer
'        Dim lgRetVal As Long  ' return value
'        Dim strBuffer As String
'
'        lgBufferLen = GetWindowTextLength(hWnd) + 1 ' get length of title bar text
'        strBuffer = VBA.Space$(lgBufferLen)  ' make room in the buffer
'        lgRetVal = GetWindowText(hWnd, strBuffer, lgBufferLen)
'        fWindowTitle = VBA.Left$(strBuffer, lgBufferLen - 1)  ' display title bar text of enumerated window
        
        ' If not handle, get the active window
        If hWnd = 0 Then hWnd = GetForegroundWindow()
        
        ' get the title of the active window
        strTitle = VBA.String(GetWindowTextLength(hWnd) + 1, VBA.Chr$(0)) ' Make the buffer
        GetWindowText hWnd, strTitle, Len(strTitle) + 1
    
        fWindowTitle = VBA.Mid$(strTitle, 1, VBA.InStr(1, strTitle, Chr$(0)) - 1)
    End Function
    
    Private Function EnumChildProc(ByVal hWnd As Long, _
                                   ByVal lParam As Long) As Long
        Dim lgRetVal As Long
        
        winNum = winNum + 1
        ReDim Preserve aChild(1 To winNum)
        With aChild(winNum)
            .ClassName = fWindowClassName(hWnd)
            .Name = fWindowTitle(hWnd)
            .hWnd = hWnd
            '.hWnd = FindWindow(.ClassName, .Name)
            'lgRetVal = FindWindowEx(hWnd, 0, .ClassName, .Name)
            'lgRetVal = FindWindowEx(hWnd, .hWnd, vbNullString, vbNullString)
            'lgRetVal = FindWindowEx(hWnd, 0&, vbNullString, vbNullString)
        End With
        
        EnumChildProc = 1  ' nonzero return value means continue enumeration
    End Function
    
    Private Function fWindowRec(ByVal hWnd As Long, _
                                ByRef Top As Long, _
                                ByRef Left As Long, _
                                ByRef Right As Long, _
                                ByRef Bottom As Long, _
                                ByRef Width As Long, _
                                ByRef Height As Long) As Boolean
    ' Get left, right, top, and bottom positions of a window in pixels.
        Dim rectWindow As RECT
         
        ' Pass in window handle and empty the data structure.
        ' If function returns 0, an error occurred.
        If GetWindowRect(hWnd, rectWindow) = 0 Then
        ' Check LastDLLError and display a dialog box if the error
        ' occurred because an invalid handle was passed.
            If Err.LastDllError = ERROR_INVALID_WINDOW_HANDLE Then
                fWindowRec = False
                'MsgBox ERROR_INVALID_WINDOW_HANDLE_DESCR, Title:="Error!"
            End If
        Else
            With rectWindow
                Bottom = .Bottom
                Left = .Left
                Right = .Right
                Top = .Top
                Width = .Right - .Left
                Height = .Bottom - .Top
            End With
            fWindowRec = True
        End If
    End Function
#End If

Following is another piece of code that did not came to much use, as I could not guess what was the intention of the code -I did really not put too much attention on the thing-. It’s filling the worksheet with names/properties, but barelly understand anything. Seems it getting all the windows in the operating system, and start a loop that seems to not have an end… But looks promissing enough to rip some code apart, starting from the winOutputType.

Public Sub GetWindowInfo()
    MsgBox "Go activate the Window you want to Spy"
    Application.Wait Now() + TimeSerial(0, 0, 5)
    
    With winOutputType
        .winHandle = 0
        .winClass = 1
        .winTitle = 2
        .winHandleClass = 3
        .winHandleTitle = 4
        .winHandleClassTitle = 5

        sGetWinInfo 0&, 0, .winHandleClassTitle
    End With
End Sub
 
#If VBA7 And Win64 Then
    Private Sub sGetWinInfo(ByRef hParent As LongPtr, _
                            ByRef intOffset As Integer, _
                            ByRef OutputType As Integer)
    ' Recursively obtain window handles, classes and text given a parent window to search
    ' Written by Mark Rowlinson
    ' www.markrowlinson.co.uk - The Programming Emporium
        Dim hWnd As Long
        Dim lngRet As Long
        Dim y As Integer
        Dim strText As String
        
        hWnd = FindWindowEx(hParent, 0&, vbNullString, vbNullString)
        While hWnd <> 0
            Select Case OutputType
                Case winOutputType.winClass
                    strText = String$(100, Chr$(0))
                    lngRet = GetClassName(hWnd, strText, 100)
                    Range("a1").Offset(x, intOffset) = Left$(strText, lngRet)
                
                Case winOutputType.winHandle
                    Range("a1").Offset(x, intOffset) = hWnd
                
                Case winOutputType.winTitle
                    strText = String$(100, Chr$(0))
                    lngRet = GetWindowText(hWnd, strText, 100)
                    If lngRet > 0 Then
                        Range("a1").Offset(x, intOffset) = Left$(strText, lngRet)
                    Else
                        Range("a1").Offset(x, intOffset) = "N/A"
                    End If
                
                Case winOutputType.winHandleClass
                    Range("a1").Offset(x, intOffset) = hWnd
                    strText = String$(100, Chr$(0))
                    lngRet = GetClassName(hWnd, strText, 100)
                    Range("a1").Offset(x, intOffset + 1) = Left$(strText, lngRet)
                
                Case winOutputType.winHandleTitle
                    Range("a1").Offset(x, intOffset) = hWnd
                    strText = String$(100, Chr$(0))
                    lngRet = GetWindowText(hWnd, strText, 100)
                    If lngRet > 0 Then
                        Range("a1").Offset(x, intOffset + 1) = Left$(strText, lngRet)
                    Else
                        Range("a1").Offset(x, intOffset + 1) = "N/A"
                    End If
                
                Case winOutputType.winHandleClassTitle
                    Range("a1").Offset(x, intOffset) = hWnd
                    strText = String$(100, Chr$(0))
                    lngRet = GetClassName(hWnd, strText, 100)
                    Range("a1").Offset(x, intOffset + 1) = Left$(strText, lngRet)
                    strText = String$(100, Chr$(0))
                    lngRet = GetWindowText(hWnd, strText, 100)
                    If lngRet > 0 Then
                        Range("a1").Offset(x, intOffset + 2) = Left$(strText, lngRet)
                    Else
                        Range("a1").Offset(x, intOffset + 2) = "N/A"
                    End If
            End Select
             
            ' check for children
            y = x
            Select Case OutputType
                Case Is > 4
                    GetWinInfo hWnd, intOffset + 3, OutputType
                Case Is > 2
                    GetWinInfo hWnd, intOffset + 2, OutputType
                Case Else
                    GetWinInfo hWnd, intOffset + 1, OutputType
            End Select
             
            ' increment by 1 row if no children found
            If y = x Then x = x + 1
             
            ' now get next window
            hWnd = FindWindowEx(hParent, hWnd, vbNullString, vbNullString)
        Wend
    End Sub

#Else
    Private Sub sGetWinInfo(ByRef hParent As Long, _
                            ByRef intOffset As Integer, _
                            ByRef OutputType As Integer)
    ' Recursively obtain window handles, classes and text given a parent window to search
    ' Written by Mark Rowlinson
    ' www.markrowlinson.co.uk - The Programming Emporium
        Dim hWnd As Long
        Dim lngRet As Long
        Dim y As Integer
        Dim strText As String
        
        hWnd = FindWindowEx(hParent, 0&, vbNullString, vbNullString)
        While hWnd <> 0
            Select Case OutputType
                Case winOutputType.winClass
                    strText = String$(100, Chr$(0))
                    lngRet = GetClassName(hWnd, strText, 100)
                    Range("a1").Offset(x, intOffset) = Left$(strText, lngRet)
                
                Case winOutputType.winHandle
                    Range("a1").Offset(x, intOffset) = hWnd
                
                Case winOutputType.winTitle
                    strText = String$(100, Chr$(0))
                    lngRet = GetWindowText(hWnd, strText, 100)
                    If lngRet > 0 Then
                        Range("a1").Offset(x, intOffset) = Left$(strText, lngRet)
                    Else
                        Range("a1").Offset(x, intOffset) = "N/A"
                    End If
                
                Case winOutputType.winHandleClass
                    Range("a1").Offset(x, intOffset) = hWnd
                    strText = String$(100, Chr$(0))
                    lngRet = GetClassName(hWnd, strText, 100)
                    Range("a1").Offset(x, intOffset + 1) = Left$(strText, lngRet)
                
                Case winOutputType.winHandleTitle
                    Range("a1").Offset(x, intOffset) = hWnd
                    strText = String$(100, Chr$(0))
                    lngRet = GetWindowText(hWnd, strText, 100)
                    If lngRet > 0 Then
                        Range("a1").Offset(x, intOffset + 1) = Left$(strText, lngRet)
                    Else
                        Range("a1").Offset(x, intOffset + 1) = "N/A"
                    End If
                
                Case winOutputType.winHandleClassTitle
                    Range("a1").Offset(x, intOffset) = hWnd
                    strText = String$(100, Chr$(0))
                    lngRet = GetClassName(hWnd, strText, 100)
                    Range("a1").Offset(x, intOffset + 1) = Left$(strText, lngRet)
                    strText = String$(100, Chr$(0))
                    lngRet = GetWindowText(hWnd, strText, 100)
                    If lngRet > 0 Then
                        Range("a1").Offset(x, intOffset + 2) = Left$(strText, lngRet)
                    Else
                        Range("a1").Offset(x, intOffset + 2) = "N/A"
                    End If
            End Select
             
            ' check for children
            y = x
            Select Case OutputType
                Case Is > 4
                    sGetWinInfo hWnd, intOffset + 3, OutputType
                Case Is > 2
                    sGetWinInfo hWnd, intOffset + 2, OutputType
                Case Else
                    sGetWinInfo hWnd, intOffset + 1, OutputType
            End Select
             
            ' increment by 1 row if no children found
            If y = x Then x = x + 1
             
            ' now get next window
            hWnd = FindWindowEx(hParent, hWnd, vbNullString, vbNullString)
        Wend
    End Sub
#End If

Next steps in development should be get the captured image inside a picture control on a new UserForm, and once all the controls are identified and located by position, recreate the original UserForm, so the GUI is cloned in no time, with -depending on the original developer effort on tidyness- probably right names (instead of CommandButton1, ListBox1,…, you know), and all the labels filled with text. The internal code is where you as a developer should put your best to emulate the original code… but that is another history.

Leave a Reply

Your email address will not be published. Required fields are marked *