Excel 如何在Visual Basic中为使用XML HTTP请求的应用程序提取web数据？

版本：Microsoft Visual Basic for Applications 7.1

我正在从事一个小型的数据挖掘/网络数据提取个人项目。不过，我的问题是关于数据提取

使用IE从网页中提取数据虽然有效，但运行速度非常慢，因此我倾向于使用XML HTTP请求。然而，当我在一个我计划开发的网站上试用它时，除了一些静态内容外，我无法提取我需要的数据。在检查响应文本时，我发现它不包含我需要的数据。它可能是由JavaScript或类似技术生成的。我不确定这些脚本是否在VBA中使用XML HTTP请求呈现，就像在web浏览器中一样

另外，这里值得注意的是，在检查来自Developer Tools>Network的网页时，它提供了一个示例，其中响应包含我需要的大部分数据，但它是JSON格式的。我不知道如何解析它，但我只是提供了这些信息，以便您可以为我指出正确的方向，以防无法使用XML HTTP请求从动态网页提取数据

我希望您能花几分钟时间来查看我的代码，以及我可能做得不正确的地方

非常感谢大家。我非常感谢你的帮助

以下是我尝试做的基本想法：

使用XML（无法提取所需数据）：

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

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

---

检查即时窗口后，显示未提取

证券符号

和

收盘价

为了进行比较，并证明要提取的数据是存在的，我在这里还提供了使用IE实例的代码

使用IE（提取数据但运行速度相对较慢）：

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

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

查看即时窗口，它显示它成功地提取了数据。然而，正如我前面所说的，它糟糕的性能让我考虑了其他选择

参考资料：

---

使用HTTP请求是一种可行的方法。正如你所说，IE速度慢，效率低

一旦您找到了返回您感兴趣的数据作为响应的请求，您的工作就相对容易了，它很可能涉及以下内容之一：

请求返回一个html页面作为响应。在这种情况下，您应该使用

Microsoft HTML对象库

，将响应HTML分配给

HTMLDocument

，并使用现有方法解析对象。为此，您需要对Microsoft HTML对象库的引用

请求返回一个

JSON

字符串。在这种情况下，您可以将响应存储在字符串变量中，并使用解析将其解析为json对象。链接中给出的说明和示例非常有用。使用在线JSON查看器了解响应的结构，您将能够提取所需的任何信息。为此，您需要参考

Microsoft脚本运行时

以及

VBA-JSON

模块

两者的结合。例如，一些请求可能返回一个HTML页面作为响应，其中包含JSON格式的数据。其他人可以返回一个JSON字符串，其中包含的一个项目可以是HTML表。在这种情况下，上述工作流程的组合将起到作用

就请求本身而言，请确保使用对请求至关重要的标头。标题

内容类型：

是其中之一，它对于

POST

请求非常重要。您可以使用

.setRequestHeader

方法。包含请求参数的请求主体也是必不可少的。我建议您使用

WinHTTP服务，版本5.1

来满足您的请求

一旦掌握了这些，您就可以完全控制要检索的数据。

这里有一组。目前，stockapi端点似乎不起作用。我提出了一个问题。如果它再次工作，您可以使用以下语法。json解析器是。将.bas添加到项目中，然后转到VBE>tools>References>AddReferencetoMicrosoftScriptingRuntime

Option Explicit
Public Sub dataMinExProject_XML()
    Dim xmlPage As MSXML2.XMLHTTP60, aDate As String, symbol As String, json As Object, url As String
    Set xmlPage = New MSXML2.XMLHTTP60
    aDate = Format$(Date - 1, "MM-DD-YYYY")
    symbol = "JFC"
    url = "http://pseapi.com/api/Stock/" & symbol & "/" & aDate

    With xmlPage
        .Open "GET", url, False
        .send
        Set json = JsonConverter.ParseJson(.responseText)
    End With
End Sub

它返回一个dictionary对象，您可以按键解析出该对象的信息

{
    "symbol":"JFC",
    "date":"15/03/2017",
    "open":197.0000,
    "high":197.4000,
    "low":195.0000,
    "close":196.0000,
    "bid":195.5000,
    "ask":196.0000,
    "volume":141740,
    "value":27747934.0000,
    "netForeign":-6464136.0000
}

以我为例：

Dim key As  Variant
For Each key In json.keys
    Debug.Print key, json(key)
Next

---

关于JSON问题，请参见@RonRosenfeld，非常感谢您提供的链接。我从其他代码中看到，它们在请求中包括

.setRequestHeader“Content Type”，“application/x-www-form-urlencoded”

。它能做什么？有没有办法只使用内置库，或者至少广泛使用的第三方工具来完成它？我赞成长期的解决办法。我担心，如果我使用的第三方工具和API的用户基数较低，那么很有可能无法对其进行常规维护，并可能在下次更新时中断。如果它坏了，那么我的代码就坏了。我喜欢为其他个人项目提供开源工具的想法，但不是在这一个项目上，因为数据的完整性在金融计算中非常重要。您提到的XHR目标似乎有一个安全措施，它只是简单地模仿头并传递来自先前GET请求的cookie，而不是绕过。我试着在帖子中传递JSESSIONID、添加标题和传递正确的正文，但仍然得到了403。也许其他人能想出解决办法。我认为网站的总体设计是为了防止容易刮擦-值得检查的条款和条件。您的IE代码很好，有一定的改进空间，但没有什么可以显著提高性能。当您提到太慢时，什么是慢？是的，几分钟前我刚刚发现，当我尝试使用XMLHTTPReq URL并检查响应文本时，它返回“拒绝访问”。但在开发者工具预览中，数据以JSON格式显示。与条款和条件一样