无需Selenium的VBA向Edge输入框批量填值问题求助

针对你遇到的SendKeys导航错位、CDP附加失败问题，以下是三种不依赖Selenium的VBA解决方案：

方案1：Windows API定位输入框句柄（彻底规避Tab导航） #

核心逻辑：跳过Tab切换，直接定位目标输入框的系统句柄，通过API发送文本，完全不受页面随机元素干扰。

代码实现 #

' 声明Windows API函数（64位Office需加PtrSafe）
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
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

Const WM_SETTEXT = &HC

Sub FillEdgeInputBoxes()
    Dim startValue As Double, repeatCount As Long, i As Long
    Dim edgeWnd As LongPtr, inputWnd As LongPtr
    
    ' 读取Excel参数
    startValue = CDbl(Range("B1").Value)
    repeatCount = CLng(Range("B3").Value)
    
    ' 等待5秒确认目标Edge窗口处于前台
    Application.Wait Now + TimeValue("00:00:05")
    
    ' 定位Edge主窗口（标题需包含"Schedule"，可根据实际调整）
    edgeWnd = FindWindow(vbNullString, "Schedule - Microsoft Edge")
    If edgeWnd = 0 Then
        MsgBox "未找到目标Edge窗口"
        Exit Sub
    End If
    
    ' 逐层定位输入框句柄（需用Spy++工具抓取实际层级/类名）
    Dim tabContainerWnd As LongPtr, contentWnd As LongPtr
    tabContainerWnd = FindWindowEx(edgeWnd, 0, "Chrome_WidgetWin_1", vbNullString)
    contentWnd = FindWindowEx(tabContainerWnd, 0, "Chrome_RenderWidgetHostHWND", vbNullString)
    ' 替换为你实际抓取到的输入框类名/标识
    inputWnd = FindWindowEx(contentWnd, 0, "Edit", vbNullString)
    
    If inputWnd = 0 Then
        MsgBox "未找到目标输入框"
        Exit Sub
    End If
    
    ' 循环填值
    For i = 1 To repeatCount
        ' 直接给输入框设置文本
        SendMessage inputWnd, WM_SETTEXT, 0, ByVal CStr(startValue)
        
        ' 可选：模拟回车提交
        ' SendMessage inputWnd, WM_KEYDOWN, VK_RETURN, 0
        ' SendMessage inputWnd, WM_KEYUP, VK_RETURN, 0
        
        WaitMillis 500
        startValue = startValue + 1
    Next i
End Sub

' 毫秒级等待函数（保留原逻辑）
Sub WaitMillis(milliseconds As Long)
    Dim startTime As Double
    startTime = Timer
    Do While Timer < startTime + (milliseconds / 1000)
        DoEvents
    Loop
End Sub

注意事项 #

• 需用Spy++工具（Visual Studio自带或独立下载）抓取Edge窗口和输入框的实际类名、层级结构，不同Edge版本的窗口类名可能略有差异
• 仅适用于原生Windows控件类型的输入框，网页HTML输入框需用方案2

方案2：直接访问网页DOM（最精准可靠） #

核心逻辑：通过COM对象获取已打开Edge页面的DOM，直接定位HTML输入框，完全避免模拟按键的不可靠性。

代码实现 #

Sub FillEdgeHTMLInputs()
    Dim startValue As Double, repeatCount As Long, i As Long
    Dim shellApp As Object, edgeWindow As Object, doc As Object
    
    ' 读取Excel参数
    startValue = CDbl(Range("B1").Value)
    repeatCount = CLng(Range("B3").Value)
    
    Set shellApp = CreateObject("Shell.Application")
    
    ' 遍历所有窗口，定位目标Edge页面
    For Each edgeWindow In shellApp.Windows
        If InStr(edgeWindow.FullName, "msedge.exe") > 0 And InStr(edgeWindow.LocationName, "Schedule") > 0 Then
            Set doc = edgeWindow.Document
            Exit For
        End If
    Next edgeWindow
    
    If doc Is Nothing Then
        MsgBox "未找到目标Edge页面"
        Exit Sub
    End If
    
    ' 循环填值（替换为实际输入框的HTML属性）
    For i = 1 To repeatCount
        ' 示例：通过ID定位输入框
        doc.getElementById("target-input-id").Value = CStr(startValue)
        
        ' 可选：模拟点击提交按钮
        ' doc.getElementById("submit-btn").Click
        
        WaitMillis 500
        startValue = startValue + 1
    Next i
End Sub

注意事项 #

• 需通过浏览器F12开发者工具获取目标输入框的HTML属性（ID、Name、Class等）
• 若页面包含iframe，需先切换到对应iframe（doc.frames("iframe-name").Document）
• 部分页面有反自动化保护，可能导致DOM访问失败，需调整页面权限或改用其他方案

方案3：改进SendKeys+鼠标点击（临时替代） #

核心逻辑：用鼠标点击输入框固定位置确保聚焦，避免Tab导航的错位问题，实现成本最低但可靠性依赖页面布局稳定性。

代码实现 #

' 声明鼠标操作API
Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Declare PtrSafe Function mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As LongPtr) As Long

Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4

Sub FillWithMouseClick()
    Dim startValue As Double, repeatCount As Long, i As Long
    
    ' 读取Excel参数
    startValue = CDbl(Range("B1").Value)
    repeatCount = CLng(Range("B3").Value)
    
    ' 激活目标Edge窗口
    On Error Resume Next
    AppActivate "Schedule - Microsoft Edge"
    On Error GoTo 0
    
    If Err.Number <> 0 Then
        MsgBox "未找到目标窗口"
        Exit Sub
    End If
    
    ' 输入框的屏幕坐标（用截图工具或Spy++获取）
    Dim inputX As Long, inputY As Long
    inputX = 500 ' 替换为实际X坐标
    inputY = 300 ' 替换为实际Y坐标
    
    For i = 1 To repeatCount
        ' 点击输入框聚焦
        SetCursorPos inputX, inputY
        mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
        mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
        WaitMillis 100
        
        ' 全选原有内容并替换
        SendKeys "^a", True
        WaitMillis 50
        SendKeys CStr(startValue), True
        WaitMillis 100
        
        ' 模拟回车提交
        SendKeys "{ENTER}", True
        WaitMillis 500
        
        startValue = startValue + 1
    Next i
End Sub

注意事项 #

• 输入框位置需固定，窗口缩放、页面滚动会导致坐标失效
• 仅作为临时替代方案，优先选择方案1或2

内容的提问来源于stack exchange，提问作者Chris Choi