VBA实现IE自动化提交网页表单后点击匹配值的href链接爬取数据

核心问题点 #

• 原有代码点击提交按钮后未等待搜索结果页面加载完成，直接终止流程
• 缺少遍历页面超链接、匹配目标搜索值并点击跳转的逻辑

修改后可完整运行的代码 #

Dim HTMLDoc As HTMLDocument
Dim oBrowser As InternetExplorer

Sub CETIP()
    Dim oHTML_Element As IHTMLElement
    Dim sURL As String
    Dim sSearchCode As String
    
    ' 配置参数
    sURL = "https://www2.cetip.com.br/TitulosCRI"
    sSearchCode = "08L0002118" ' 可替换为实际需要搜索的编码
    
    On Error GoTo Err_Handler
    
    ' 初始化浏览器并加载目标页面
    Set oBrowser = New InternetExplorer
    oBrowser.Silent = True
    oBrowser.Navigate sURL
    oBrowser.Visible = True
    
    ' 等待初始页面加载完成
    Do Until oBrowser.ReadyState = READYSTATE_COMPLETE
        DoEvents
    Loop
    Set HTMLDoc = oBrowser.document
    
    ' 填充搜索字段
    HTMLDoc.all.ddlCodigoIF.Value = sSearchCode
    
    ' 点击提交按钮
    For Each oHTML_Element In HTMLDoc.getElementsByTagName("input")
        If oHTML_Element.Type = "submit" Then
            oHTML_Element.Click
            Exit For
        End If
    Next
    
    ' 等待搜索结果页加载完成，额外延迟2秒避免动态元素未渲染
    Do Until oBrowser.ReadyState = READYSTATE_COMPLETE
        DoEvents
    Loop
    Application.Wait Now + TimeValue("00:00:02")
    Set HTMLDoc = oBrowser.document ' 重新绑定文档对象，避免旧对象缓存
    
    ' 遍历所有超链接，匹配目标编码并点击跳转
    For Each oHTML_Element In HTMLDoc.getElementsByTagName("a")
        If Trim(oHTML_Element.innerText) = sSearchCode Then
            oHTML_Element.Click
            Exit For
        End If
    Next
    
    ' 等待详情页加载完成后即可开展后续数据爬取操作
    Do Until oBrowser.ReadyState = READYSTATE_COMPLETE
        DoEvents
    Loop
    Application.Wait Now + TimeValue("00:00:02")

Exit Sub

Err_Handler:
    MsgBox "运行出错：" & Err.Description, vbCritical
    ' 可根据需求补充错误处理逻辑
End Sub

关键调整说明 #

• 新增DoEvents避免页面加载等待期间程序无响应
• 提交表单后新增两层加载等待逻辑，确保搜索结果、详情页元素完全渲染后再执行操作
• 将搜索值抽为独立变量sSearchCode，后续修改搜索内容无需调整多处代码
• 新增超链接遍历匹配逻辑，精准定位与搜索值同名的链接并自动点击
• 移除原有的全局错误吞除逻辑，改为弹窗提示具体错误，降低调试难度

内容的提问来源于stack exchange，提问作者Renner Abram