从网页代码中提取文本vba excel

Question

我有这个示例代码，其中使用一种方法从网页中提取文本。在完整的代码中，这些页面随后用于非常快速地提取整个系列的数据。完整的代码已停止工作，因为用于仅从网页中提取文本的这部分已停止正常工作，或者更确切地说，如果我使用 Excel 2010，它仍然可以工作，而它在 Excel 365 上已停止正常工作几年了，可能经过一些更新。它不是只返回文本，而是返回 JavaScript、CSS 和文本的混合体。另一个奇怪的事情是，它对我的一位使用 Office 365 Enterprise 的熟人来说经常有效。您是否认为它也可以在 Excel 365 上运行，或者这是一个 Excel bug？仅显示非功能部分的示例代码如下：

Sub EstraiTestoDaPaginaWeb()
    Dim xmlHttp As Object
    Dim html As Object
    Dim testoEstratto As String
    Dim elem As Object

    ' Creazione dell'oggetto XMLHTTP
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")

    ' URL della pagina web
    Dim url As String
    url = "https://www.borsaitaliana.it/borsa/obbligazioni/mot/btp/scheda/IT0001086567.html?lang=it"

    ' Invio della richiesta
    xmlHttp.Open "GET", url, False
    xmlHttp.send

    ' Creazione dell'oggetto HTMLDocument
    Set html = CreateObject("HTMLFILE")
    html.body.innerHTML = xmlHttp.responseText

    ' Estrazione del testo
    testoEstratto = html.body.innerText

    ' Visualizzare il testo estratto
    MsgBox testoEstratto
End Sub

Excel 2010 结果：

Excel 365 结果：

Answer 1

您正在使用的网页由

JSON feed

填充，可以通过以下代码提取。

然后，您可以使用

Regular Expressions

或使用

JSON Parser

https://github.com/VBA-tools/VBA-JSON

给出的 Tim Hall

来解析 JSon 响应

Sub Test()
    Dim xmlHttp As Object, URL As String, PayLoad As String
    Dim HTML As Object, strJSON As String

    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")

    URL = "https://charts.borsaitaliana.it/charts/services/ChartWService.asmx/GetPrices"
    
    PayLoad = "{""request"":{""SampleTime"":""1mm"",""TimeFrame"":""1d"",""RequestedDataSetType"":""ohlc""," _
            & """ChartPriceType"":""price"",""Key"":""IT0001086567.MOT"",""OffSet"":0,""FromDate"":null," _
            & """ToDate"":null,""UseDelay"":false,""KeyType"":""Topic"",""KeyType2"":""Topic"",""Language"":""it-IT""}}"
    
    xmlHttp.Open "POST", URL, False
    xmlHttp.setRequestHeader "Content-Type", "application/json"
    xmlHttp.send PayLoad

    Set HTML = CreateObject("HTMLFILE")
    HTML.body.innerHTML = xmlHttp.responseText

    strJSON = HTML.body.innerText

    MsgBox strJSON
End Sub