使用WinAPI获取第三方应用窗口文本的VBA代码类型不匹配问题

问题描述 #

编写VBA脚本通过WinAPI的WM_GETTEXT消息获取本地应用程序文本时，出现类型不匹配编译错误（Erro de Compilação - Tipos Incompatíveis），错误指向代码第5行。原代码如下：

Option Explicit
    
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Public Function GetWindowTextFromWindow(ByVal windowTitle As String) As String
    Dim hWnd As LongPtr
    Dim textLength As LongPtr
    Dim buffer As String
    Dim Test As LongPtr
    Const WM_GETTEXT As LongPtr = &HD
    Const WM_GETTEXTLENGTH As LongPtr = &HE
    Const MAX_TEXT_LENGTH As LongPtr = 4096 ' Adjust as needed

    hWnd = FindWindow(vbNullString, windowTitle)
    
    If hWnd <> 0 Then
        textLength = SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0)
        If textLength > 0 Then
            'Range("A1") = textLength
            buffer = String(textLength, vbNullChar) ' The problem is clearly on the textLength var
            SendMessage hWnd, WM_GETTEXT, textLength + 1, ByVal buffer
            GetWindowTextFromWindow = Left(buffer, textLength)
        End If
    Else
        GetWindowTextFromWindow = "Window not found."
    End If
End Function

Sub TestGetWindowText()
    Dim windowTitle As String
    Dim windowText As String
    
    ' Set the window title of the third-party application
    windowTitle = "Novo Rede Caixa - pw3270:A - ibmrj10.corerj.caixa"
    
    windowText = GetWindowTextFromWindow(windowTitle)
    
    MsgBox windowText, vbInformation, "Window Text"
End Sub

错误原因 #

1. WinAPI的消息ID（如WM_GETTEXT、WM_GETTEXTLENGTH）是固定的32位整数，在VBA中应使用Long类型，而非LongPtr。原代码将这些常量声明为LongPtr，与SendMessage声明中wMsg As Long的参数类型不匹配，触发编译错误。
2. textLength变量接收WM_GETTEXTLENGTH的返回值，该返回值为Long类型，使用LongPtr会导致类型不兼容。
3. MAX_TEXT_LENGTH作为文本长度上限，用普通Long类型即可满足需求，无需LongPtr。

修正后的代码 #

Option Explicit
    
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Public Function GetWindowTextFromWindow(ByVal windowTitle As String) As String
    Dim hWnd As LongPtr
    Dim textLength As Long
    Dim buffer As String
    Const WM_GETTEXT As Long = &HD
    Const WM_GETTEXTLENGTH As Long = &HE
    Const MAX_TEXT_LENGTH As Long = 4096 ' Adjust as needed

    hWnd = FindWindow(vbNullString, windowTitle)
    
    If hWnd <> 0 Then
        textLength = SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0)
        ' 限制文本长度，避免缓冲区溢出
        If textLength > 0 And textLength <= MAX_TEXT_LENGTH Then
            buffer = String(textLength, vbNullChar)
            SendMessage hWnd, WM_GETTEXT, textLength + 1, ByVal buffer
            GetWindowTextFromWindow = Left(buffer, textLength)
        ElseIf textLength > MAX_TEXT_LENGTH Then
            GetWindowTextFromWindow = "Text length exceeds maximum limit."
        End If
    Else
        GetWindowTextFromWindow = "Window not found."
    End If
End Function

Sub TestGetWindowText()
    Dim windowTitle As String
    Dim windowText As String
    
    ' Set the window title of the third-party application
    windowTitle = "Novo Rede Caixa - pw3270:A - ibmrj10.corerj.caixa"
    
    windowText = GetWindowTextFromWindow(windowTitle)
    
    MsgBox windowText, vbInformation, "Window Text"
End Sub

关键修改说明 #

• 将WM_GETTEXT、WM_GETTEXTLENGTH、MAX_TEXT_LENGTH的类型从LongPtr改为Long，匹配WinAPI参数要求。
• 将textLength变量类型改为Long，与SendMessage返回的WM_GETTEXTLENGTH结果类型一致。
• 增加文本长度上限校验，避免缓冲区溢出问题。

内容的提问来源于stack exchange，提问作者Luan Feitosa