VBA 7.1中XML HTTP请求提取动态网页数据问题求助

嘿，我懂你的困扰——用IE爬数据虽然能成，但慢得让人抓狂，换成XMLHTTP又拿不到那些动态加载的核心数据对吧？咱们一步步来解决：

问题根源先搞清楚 #

首先，XMLHTTP请求只会获取页面的原始静态HTML，完全不会执行页面里的JavaScript。你要的证券代码、收盘价这些数据，是页面加载完成后，通过JS偷偷请求后台接口动态渲染出来的，所以自然不会出现在XMLHTTP返回的responseText里。而你在Network面板找到的那个JSON请求，就是直接返回这些数据的数据源，这才是咱们该抓的重点！

先看看你现有的代码情况 #

XML HTTP方式（无法提取目标动态数据） #

Option Explicit
Sub dataMinExProject_XML()
 Dim xmlPage As MSXML2.XMLHTTP60
 Dim htmlDoc As MSHTML.HTMLDocument
 Dim coName As MSHTML.IHTMLElement
 Dim secSym As MSHTML.IHTMLElement
 Dim closePrice As MSHTML.IHTMLElement
 Dim URL As String
 URL = "https://www.pse.com.ph/stockMarket/companyInfo.html?id=260&security=468&tab=0"
 Set xmlPage = New MSXML2.XMLHTTP60
 With xmlPage
 .Open "POST", URL, False
 .send
 End With
 Do Until xmlPage.ReadyState = 4
 DoEvents
 Loop
 Set htmlDoc = New MSHTML.HTMLDocument
 htmlDoc.body.innerHTML = xmlPage.responseText
 Set coName = htmlDoc.getElementById("comTopInfoHead").Children(0)
 Set secSym = htmlDoc.getElementById("secSymbol")
 Set closePrice = htmlDoc.getElementById("headerLastTradePrice")
 Debug.Print "Company Name: ", """" & coName.innerText & """"
 Debug.Print "Security Symbol: ", """" & secSym.innerText & """"
 Debug.Print "Closing Price: ", """" & closePrice.innerText & """"
 xmlPage.abort
 Set xmlPage = Nothing
 MsgBox ("alright!")
End Sub

立即窗口输出：

Company Name: "BDO Unibank, Inc."
Security Symbol: ""
Closing Price: " "

IE方式（可提取数据但速度极慢） #

Option Explicit
Sub dataMinExProject_IE()
 Dim ieApp As SHDocVw.InternetExplorer
 Dim htmlDoc As MSHTML.HTMLDocument
 Dim coName As MSHTML.IHTMLElement
 Dim secSym As MSHTML.IHTMLElement
 Dim closePrice As MSHTML.IHTMLElement
 Dim URL As String
 URL = "https://www.pse.com.ph/stockMarket/companyInfo.html?id=260&security=468&tab=0"
 Set ieApp = New SHDocVw.InternetExplorer
 With ieApp
 .Navigate (URL)
 .Visible = vbTrue
 End With
 Do Until ieApp.ReadyState = READYSTATE_COMPLETE
 DoEvents
 Loop
 Set htmlDoc = ieApp.Document
 Set coName = htmlDoc.getElementById("comTopInfoHead").Children(0)
 Set secSym = htmlDoc.getElementById("secSymbol")
 Set closePrice = htmlDoc.getElementById("headerLastTradePrice")
 Do Until secSym.innerText <> vbNullString And closePrice.innerText <> vbNullString
 Loop
 DoEvents
 Debug.Print "Company Name: ", """" & coName.innerText & """"
 Debug.Print "Security Symbol: ", """" & secSym.innerText & """"
 Debug.Print "Closing Price: ", """" & closePrice.innerText & """"
 ieApp.Quit
 Set ieApp = Nothing
 MsgBox ("alright!")
End Sub

立即窗口输出：

Company Name: "BDO Unibank, Inc."
Security Symbol: "BDO"
Closing Price: "130.50"

正确解决方案：直接请求JSON接口并解析 #

既然找到了返回JSON数据的接口，咱们直接请求它就行，速度比IE快N倍！步骤如下：

1. 准备工作 #

首先在VBA编辑器里添加两个引用：

• Microsoft XML, v6.0（用于XMLHTTP请求）
• Microsoft Scripting Runtime（用于JSON解析）

2. 代码示例 #

Option Explicit
Sub dataMinExProject_JSON()
    Dim xmlPage As MSXML2.XMLHTTP60
    Dim jsonText As String
    Dim jsonObj As Object
    Dim targetURL As String
    
    ' 替换成你在Network面板找到的那个JSON请求URL
    ' 比如类似这样的格式：https://www.pse.com.ph/api/data/companyInfo?id=260&security=468
    targetURL = "这里换成你找到的实际JSON接口地址"
    
    ' 发送请求获取JSON数据
    Set xmlPage = New MSXML2.XMLHTTP60
    With xmlPage
        .Open "GET", targetURL, False
        ' 模拟浏览器请求头，防止被拦截（可选但推荐）
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/114.0.0.0 Safari/537.36"
        .send
    End With
    
    ' 等待请求完成
    Do Until xmlPage.ReadyState = 4
        DoEvents
    Loop
    
    ' 获取JSON文本
    jsonText = xmlPage.responseText
    xmlPage.abort
    Set xmlPage = Nothing
    
    ' 解析JSON数据
    Set jsonObj = ParseJSON(jsonText)
    
    ' 根据实际JSON结构提取数据，这里需要你自己对照接口响应调整字段名
    ' 比如假设JSON里的字段是companyName、secSymbol、lastTradePrice
    Debug.Print "Company Name: ", """" & jsonObj("companyName") & """"
    Debug.Print "Security Symbol: ", """" & jsonObj("secSymbol") & """"
    Debug.Print "Closing Price: ", """" & jsonObj("lastTradePrice") & """"
    
    MsgBox ("数据提取完成！")
End Sub

' 通用JSON解析函数
Function ParseJSON(jsonText As String) As Object
    Dim sc As Object
    Set sc = CreateObject("ScriptControl")
    sc.Language = "JScript"
    ' 用JS解析JSON并返回对象
    Set ParseJSON = sc.Eval("(" & jsonText & ")")
End Function

3. 关键注意点 #

• 找到正确的JSON接口：在Network面板里，刷新页面后找XHR/Fetch类型的请求，查看响应内容确认包含你需要的数据。
• 调整字段名：打开JSON响应（可以用浏览器的Preview或者复制到JSON格式化工具里），找到对应证券代码、收盘价的字段名，替换代码里的字段引用。
• 请求头设置：如果接口返回403或者无数据，添加User-Agent甚至Referer请求头，模拟正常浏览器访问。

这样一来，你就能快速拿到想要的数据，再也不用忍受IE的慢速度啦！

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