基于窗口标题获取第三方应用子窗口的VBA API问题排查

问题描述 #

• 子窗口枚举结果异常：无论实际窗口数量多少，始终仅返回6个结果（实际原代码逻辑根本未收集多窗口）
• 无法向第三方应用发送按键：尝试SendMessage发送F5、Alt+F4无响应

需求：枚举标题以“Bán hàng”（Unicode格式：windowTitle = "B" & ChrW(225) & "n h" & ChrW(224) & "ng h" & ChrW(243) & "a*"）开头的第三方应用子窗口，依次激活并执行F5刷新、Alt+F4关闭操作。

问题根源 #

1. 枚举逻辑缺陷 #

• 仅返回第一个匹配窗口：原EnumWindowProc找到第一个匹配项就终止枚举，未收集所有符合条件的窗口
• ANSI API处理Unicode字符乱码：使用GetWindowTextA等ANSI版本API读取越南语标题，导致字符解析错误，匹配逻辑失效
• 未递归枚举子窗口：仅尝试获取父窗口的第一个子窗口，未遍历所有层级子窗口

2. 按键发送失效原因 #

• 消息发送对象错误：直接给子窗口发WM_KEYDOWN，多数应用的按键响应需要焦点落在特定控件上，或需使用系统级按键模拟
• 焦点未确保：SetForegroundWindow可能被系统拦截，且未等待窗口真正激活就执行操作
• 组合键逻辑错误：Alt+F4属于系统按键，需用WM_SYSKEYDOWN而非普通WM_KEYDOWN，原代码消息类型错误

修正后的完整代码 #

#If VBA7 Then
    ' 统一使用Unicode版本API处理非ASCII字符
    Private Declare PtrSafe Function EnumWindows Lib "user32" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
    Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextW" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
    Private Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthW" (ByVal hWnd As LongPtr) As Long
    Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As LongPtr) As Long
    Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hWnd As LongPtr) As Long
    Private Declare PtrSafe Function EnumChildWindows Lib "user32" (ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
    Private Declare PtrSafe Function SendInput Lib "user32" (ByVal nInputs As Long, pInputs As INPUT, ByVal cbSize As Long) As Long
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextW" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
    Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthW" (ByVal hwnd As Long) As Long
    Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
    Private Declare Function SendInput Lib "user32" (ByVal nInputs As Long, pInputs As INPUT, ByVal cbSize As Long) As Long
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

' SendInput所需的输入结构
Private Type INPUT
    #If VBA7 Then
        type As LongPtr
    #Else
        type As Long
    #End If
    ki As KEYBDINPUT
End Type

Private Type KEYBDINPUT
    wVk As Integer
    wScan As Integer
    dwFlags As Long
    time As Long
    dwExtraInfo As LongPtr
End Type

' 常量定义
Private Const INPUT_KEYBOARD As Long = 1
Private Const KEYEVENTF_KEYUP As Long = &H2
Private Const VK_F5 As Long = &H74
Private Const VK_MENU As Long = &H12
Private Const VK_F4 As Long = &H73

' 存储所有匹配窗口的全局数组
#If VBA7 Then
    Dim matchedWindows() As LongPtr
#Else
    Dim matchedWindows() As Long
#End If

Public Sub ProcessTargetWindows()
    Dim titlePattern As String
    Dim i As Long
    
    ' 设置Unicode标题匹配模式
    titlePattern = "B" & ChrW(225) & "n h" & ChrW(224) & "ng h" & ChrW(243) & "a*"
    
    ' 初始化匹配窗口数组
    ReDim matchedWindows(0 To -1)
    
    ' 枚举所有顶级窗口及子窗口
    EnumWindows AddressOf EnumTopLevelProc, StrPtr(titlePattern)
    
    ' 遍历执行操作
    For i = LBound(matchedWindows) To UBound(matchedWindows)
        If IsWindowVisible(matchedWindows(i)) Then
            ' 激活窗口并等待响应
            SetForegroundWindow matchedWindows(i)
            Sleep 300
            
            ' 发送F5刷新
            SimulateKey VK_F5, False
            Sleep 100
            SimulateKey VK_F5, True
            
            ' 等待刷新完成（根据应用调整时长）
            Sleep 600
            
            ' 发送Alt+F4关闭窗口
            SimulateKey VK_MENU, False
            Sleep 50
            SimulateKey VK_F4, False
            Sleep 50
            SimulateKey VK_F4, True
            Sleep 50
            SimulateKey VK_MENU, True
            
            ' 等待窗口关闭
            Sleep 500
        End If
    Next i
End Sub

#If VBA7 Then
Private Function EnumTopLevelProc(ByVal hWnd As LongPtr, ByVal lParam As LongPtr) As Long
#Else
Private Function EnumTopLevelProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
#End If
    Dim pattern As String
    pattern = StrConv(StrPtr(lParam), vbUnicode)
    
    ' 检查顶级窗口是否匹配
    If GetWindowTitle(hWnd) Like pattern Then
        AddToMatchedList hWnd
    End If
    
    ' 递归枚举子窗口
    EnumChildWindows hWnd, AddressOf EnumChildProc, lParam
    
    ' 继续枚举下一个顶级窗口
    EnumTopLevelProc = 1
End Function

#If VBA7 Then
Private Function EnumChildProc(ByVal hWnd As LongPtr, ByVal lParam As LongPtr) As Long
#Else
Private Function EnumChildProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
#End If
    Dim pattern As String
    pattern = StrConv(StrPtr(lParam), vbUnicode)
    
    ' 检查子窗口是否匹配
    If GetWindowTitle(hWnd) Like pattern Then
        AddToMatchedList hWnd
    End If
    
    ' 继续枚举下一个子窗口
    EnumChildProc = 1
End Function

#If VBA7 Then
Private Sub AddToMatchedList(ByVal hWnd As LongPtr)
#Else
Private Sub AddToMatchedList(ByVal hWnd As Long)
#End If
    ReDim Preserve matchedWindows(0 To UBound(matchedWindows) + 1)
    matchedWindows(UBound(matchedWindows)) = hWnd
End Sub

#If VBA7 Then
Private Function GetWindowTitle(ByVal hWnd As LongPtr) As String
#Else
Private Function GetWindowTitle(ByVal hWnd As Long) As String
#End Function
    Dim titleLen As Long
    Dim title As String
    
    titleLen = GetWindowTextLength(hWnd)
    If titleLen > 0 Then
        title = Space(titleLen + 1)
        GetWindowText hWnd, title, Len(title)
        GetWindowTitle = Left(title, titleLen)
    Else
        GetWindowTitle = ""
    End If
End Function

Private Sub SimulateKey(ByVal vkCode As Long, ByVal isUp As Boolean)
    Dim input As INPUT
    Dim kbInput As KEYBDINPUT
    
    kbInput.wVk = vkCode
    kbInput.wScan = 0
    kbInput.dwFlags = IIf(isUp, KEYEVENTF_KEYUP, 0)
    kbInput.time = 0
    kbInput.dwExtraInfo = 0
    
    input.type = INPUT_KEYBOARD
    input.ki = kbInput
    
    SendInput 1, input, Len(input)
End Sub

关键修正说明 #

1. Unicode API适配：替换所有ANSI版本API为Unicode版本（后缀W），确保越南语标题正确读取和匹配
2. 完整窗口枚举：
   • 用EnumWindows枚举顶级窗口，EnumChildWindows递归枚举所有子窗口
   • 全局数组收集所有匹配窗口，解决原代码仅返回第一个匹配项的问题
3. 稳定按键模拟：
   • 替换过时的keybd_event为SendInput，符合系统输入规范，避免被拦截
   • 添加Sleep等待窗口激活和操作响应，适配不同应用的响应速度
   • 严格按照按键按下/抬起顺序发送组合键，确保系统正确识别Alt+F4
4. 有效性过滤：添加IsWindowVisible判断，跳过不可见窗口，避免无效操作

内容的提问来源于stack exchange，提问作者Học Lê