如何使用VBA提取网页指定文本 现有代码无法取数求解决方案

问题原因 #

• 目标元素类名gNO89b是页面JavaScript执行后动态生成的内容，你当前使用的MSXML2.XMLHTTP仅能获取静态原始HTML，不会执行页面JS，因此返回的源码中不存在该元素，自然无法提取到对应文本。
• 原代码填写的请求地址为HTTP协议的谷歌地址，当前谷歌全站强制跳转HTTPS，默认配置下MSXML2.XMLHTTP不会自动跟随重定向，请求返回的不是完整首页内容。
• 代码缺少请求状态判断、元素存在性判断逻辑，一旦请求失败或者元素不存在会直接抛出运行时错误。
• 若使用New HTMLDocument写法，需要提前在VBA编辑器的「工具-引用」中勾选 Microsoft HTML Object Library，否则会触发「用户类型未定义」报错。

修复后代码 #

Sub get_text_from_web()
    Dim request As Object
    Dim response As String
    Dim html As HTMLDocument
    Dim website As String
    Dim ab As Variant
    Dim targetElements As Object
    
    ' 改为HTTPS协议地址
    website = "https://www.google.com"
    ' 用高版本XMLHTTP对象兼容性更好
    Set request = CreateObject("MSXML2.XMLHTTP.6.0")
    request.Open "GET", website, False
    ' 添加浏览器UA请求头，避免被反爬策略拦截
    request.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/118.0.0.0 Safari/537.36"
    request.Send
    
    ' 先判断请求是否成功
    If request.Status = 200 Then
        response = StrConv(request.responseBody, vbUnicode)
        Set html = New HTMLDocument
        html.body.innerHTML = response
        
        ' 先判断目标元素是否存在，避免运行时报错
        Set targetElements = html.getElementsByClassName("gNO89b")
        If targetElements.Length > 0 Then
            ab = targetElements(0).innerText
            MsgBox ab
        Else
            MsgBox "未找到目标元素，该元素为动态渲染内容，静态请求无法获取"
        End If
    Else
        MsgBox "请求失败，状态码：" & request.Status
    End If
    
    ' 释放对象资源
    Set targetElements = Nothing
    Set html = Nothing
    Set request = Nothing
End Sub

动态元素提取替代方案 #

如果确实需要获取JS渲染后的动态元素，可选择以下方案：

• 改用InternetExplorer.Application对象模拟浏览器打开页面，等待页面加载完成后再提取元素，该对象会自动执行页面脚本渲染动态内容
• 提前确认目标内容是否存在于静态HTML中：在浏览器按F12打开开发者工具，切换到「网络」面板刷新页面，找到对应页面请求的响应内容，搜索目标类名/文本是否存在，存在的话可以调整提取规则直接用静态请求获取

内容的提问来源于stack exchange，提问作者Nupur Priya