如何用VBA+Windows API稳定给指定程序发按键？支持进程/路径识别

1. 可靠发送按键的方法 #

要实现稳定无失败的按键发送，核心是精准定位并激活目标窗口，再配合Windows官方推荐的输入模拟API：

• 先通过可靠方式获取目标窗口句柄（HWND）
• 调用SetForegroundWindow将窗口置顶激活，避免被其他窗口遮挡
• 用SendInput替代SendKeys或keybd_event，该API是Windows原生推荐的模拟输入接口，稳定性更强，能绕过部分程序的输入拦截机制
• 发送按键前添加短暂延迟（如Sleep 100），给窗口激活预留足够时间

示例VBA代码片段：

Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare PtrSafe Function SendInput Lib "user32" (ByVal nInputs As Long, pInputs As Any, ByVal cbSize As Long) As Long

' 定义INPUT结构体
Type INPUT
    type As Long
    dx As Long
    dy As Long
    mouseData As Long
    dwFlags As Long
    time As Long
    dwExtraInfo As LongPtr
End Type

' 向指定窗口发送Enter键示例
Sub SendKeyToWindow(hwnd As LongPtr)
    If hwnd = 0 Then Exit Sub
    ' 激活目标窗口
    SetForegroundWindow hwnd
    Sleep 100 ' 等待窗口完全激活
    
    Dim inputDown As INPUT, inputUp As INPUT
    ' 模拟按键按下
    inputDown.type = 1 ' 标记为键盘输入
    inputDown.dwFlags = 0 ' 按下状态
    inputDown.dx = &HD ' VK_RETURN对应Enter键
    
    ' 模拟按键释放
    inputUp.type = 1
    inputUp.dwFlags = 2 ' 释放状态
    inputUp.dx = &HD
    
    SendInput 1, inputDown, Len(inputDown)
    SendInput 1, inputUp, Len(inputUp)
End Sub

2. 通过程序路径/进程名识别窗口 #

完全可以脱离窗口标题，通过进程名或程序文件路径定位目标窗口，以下是两种实现方式：

方式1：通过进程名（如chrome.exe）匹配 #

• 用CreateToolhelp32Snapshot枚举系统所有进程，找到目标进程的PID
• 遍历所有顶层窗口，通过GetWindowThreadProcessId获取窗口所属PID，匹配后得到窗口句柄

示例VBA代码片段：

Declare PtrSafe Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As LongPtr
Declare PtrSafe Function Process32First Lib "kernel32" (ByVal hSnapshot As LongPtr, lppe As PROCESSENTRY32) As Long
Declare PtrSafe Function Process32Next Lib "kernel32" (ByVal hSnapshot As LongPtr, lppe As PROCESSENTRY32) As Long
Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As LongPtr, lpdwProcessId As Long) As Long
Declare PtrSafe Function EnumWindows Lib "user32" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long

Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As LongPtr
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * 260
End Type

' 存储找到的目标窗口句柄
Dim targetHwnd As LongPtr

Function EnumWindowsProc(ByVal hwnd As LongPtr, ByVal lParam As Long) As Long
    Dim pid As Long
    GetWindowThreadProcessId hwnd, pid
    ' 匹配目标进程PID，找到后停止枚举
    If pid = lParam Then
        targetHwnd = hwnd
        EnumWindowsProc = 0
        Exit Function
    End If
    EnumWindowsProc = 1 ' 继续枚举其他窗口
End Function

' 根据进程名获取窗口句柄
Function GetHwndByProcessName(processName As String) As LongPtr
    Dim hSnapshot As LongPtr
    Dim pe32 As PROCESSENTRY32
    pe32.dwSize = Len(pe32)
    hSnapshot = CreateToolhelp32Snapshot(2, 0) ' 枚举所有进程
    
    If Process32First(hSnapshot, pe32) Then
        Do
            Dim currentProcName As String
            currentProcName = LCase(Left(pe32.szExeFile, InStr(pe32.szExeFile, vbNullChar) - 1))
            If currentProcName = LCase(processName) Then
                targetHwnd = 0
                EnumWindows AddressOf EnumWindowsProc, pe32.th32ProcessID
                GetHwndByProcessName = targetHwnd
                Exit Do
            End If
        Loop While Process32Next(hSnapshot, pe32)
    End If
End Function

方式2：通过程序完整路径匹配 #

在枚举进程时，通过GetModuleFileNameEx获取进程的完整执行路径，匹配精度更高，可避免同名进程干扰：

Declare PtrSafe Function GetModuleFileNameEx Lib "psapi.dll" Alias "GetModuleFileNameExA" (ByVal hProcess As LongPtr, ByVal hModule As LongPtr, ByVal lpFileName As String, ByVal nSize As Long) As Long
Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As LongPtr
Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As Long

' 根据程序完整路径获取窗口句柄
Function GetHwndByExePath(exePath As String) As LongPtr
    Dim hSnapshot As LongPtr
    Dim pe32 As PROCESSENTRY32
    pe32.dwSize = Len(pe32)
    hSnapshot = CreateToolhelp32Snapshot(2, 0)
    
    If Process32First(hSnapshot, pe32) Then
        Do
            Dim hProcess As LongPtr
            ' 申请进程查询权限
            hProcess = OpenProcess(&H400 Or &H10, 0, pe32.th32ProcessID)
            If hProcess <> 0 Then
                Dim pathBuffer As String * 512
                GetModuleFileNameEx hProcess, 0, pathBuffer, 512
                Dim fullPath As String
                fullPath = LCase(Left(pathBuffer, InStr(pathBuffer, vbNullChar) - 1))
                If fullPath = LCase(exePath) Then
                    targetHwnd = 0
                    EnumWindows AddressOf EnumWindowsProc, pe32.th32ProcessID
                    GetHwndByExePath = targetHwnd
                    CloseHandle hProcess
                    Exit Do
                End If
                CloseHandle hProcess
            End If
        Loop While Process32Next(hSnapshot, pe32)
    End If
End Function

注意事项 #

• 64位Office需在API声明前加PtrSafe，32位Office可去掉
• 部分程序存在多窗口（如Chrome的标签页窗口），可配合IsWindowVisible过滤不可见窗口，或用GetClassName匹配窗口类名进一步筛选
• 运行代码时可能需要管理员权限，否则无法访问部分系统进程

内容的提问来源于stack exchange，提问作者Lv Linh