Как получить внутренний текст внутри тега?

Question

Я пишу VBA для извлечения таблицы из стандартного веб-сайта с использованием XML, но не могу извлечь внутренний текст внутри тега. Могу я узнать, что не так с моим кодом?

Я попытался получить внутренний текст с помощью xxxx.innerText, в котором xxxx является элементом MSHTML.IHTMLElement.

Sub ProcessHTMLPage(HTMLPage As MSHTML.HTMLDocument)

    Dim htmlTable As MSHTML.IHTMLElement
    Dim htmlTables As MSHTML.IHTMLElementCollection
    Dim htmlrow As MSHTML.IHTMLElement
    Dim htmlcell As MSHTML.IHTMLElement
    Dim RowNum As Integer
    Dim ColNum As Integer

    Set htmlTables = HTMLPage.getElementsByTagName("table")
    For Each htmlTable In htmlTables

    If htmlTable.className = "table_list" Then

        RowNum = 2
        For Each htmlrow In htmlTable.getElementsByTagName("tr")

            ColNum = 1
            For Each htmlcell In htmlrow.Children
                Debug.Print htmlcell.innerText
                ColNum = ColNum + 1
            Next htmlcell

        RowNum = RowNum + 1
        Next htmlrow

    End If
    Next htmlTable

End Sub

Sub GetPrice()

    Dim XMLPage As New MSXML2.XMLHTTP60
    Dim HTMLDoc As New MSHTML.HTMLDocument
    Dim URL As String

    URL = "https://www.hkex.com.hk/Market-Data/Securities-Prices/Equities/Equities-Quote?sym=2&sc_lang=zh-hk"
    XMLPage.Open "GET", URL, False
    XMLPage.send
    HTMLDoc.body.innerHTML = XMLPage.responseText

    ProcessHTMLPage HTMLDoc

End Sub

Я ожидаю, что результат должен быть:

即日 52 周 最高 價
HK $ 90,700
HK $ 97,400 ...

Answer 1

Страница динамически загружает это содержимое, поэтому запрос xhr к исходному URL не дает ожидаемого результата.

Однако вы можете посмотреть на вкладке сети браузера и найти конечную точку, которую страница использует для обновления контента через отдельную xhr.

В следующем я не уверен, если токен основан на времени, но вы можете исследовать это. Вам нужно удалить внешнюю строку jquery, но затем вы можете проанализировать внутренний json с помощью парсера json. Я использую jsonconverter.bas . Вы загружаете код jsonconverter.bas в стандартный модуль с именем JsonConverter, затем идете VBE> Инструменты> Ссылки> Добавить ссылку на Microsoft Scripting Runtime. Если вы не хотите использовать парсер json (парсер должен быть вашим предпочтением), вы можете использовать функцию split для экстракции нужной вам информации.

Я бы настроил формат таблицы на вашем листе так, как вы хотите (например, как показано на веб-странице), с заголовками столбцов и строк, а затем назначил значения из переменных ниже для ячеек в пределах этот стол. Вы можете привязать к кнопке, чтобы вы могли обновить таблицу на листе по желанию.

---

Макет (и результат):

---

Код:

Option Explicit
Public Sub GetInfo()
    Dim s As String, json As Object
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www1.hkex.com.hk/hkexwidget/data/getequityquote?sym=2&token=evLtsLsBNAUVTPxtGqVeG6jZbQlrF5FojHmveNua5GgTcjPuBcUs7GTV0hIBAgAI&lang=chi&qid=1560281438643&callback=jQuery311003616462678192556_1560281436567&_=1560281436568", False
        .send
        s = Split(Split(.responseText, "(")(1), ")")(0)
    End With
    Set json = JsonConverter.ParseJson(s)("data")("quote")

    Dim sameDayHigh As Double, fiftyTwoWeekHigh As Double, sameDayLow As Double, fiftyTwoWeekLow As Double, timeInfo As String

    sameDayHigh = json("hi")
    sameDayLow = json("lo")
    fiftyTwoWeekHigh = json("hi52")
    fiftyTwoWeekLow = json("lo52")
    timeInfo = json("updatetime")

    With ThisWorkbook.Worksheets("Sheet1")
        .Cells(1, 1) = timeInfo
        .Cells(3, 2).Resize(1, 2) = Array(sameDayHigh, fiftyTwoWeekHigh)
        .Cells(4, 2).Resize(1, 2) = Array(sameDayLow, fiftyTwoWeekLow)
    End With
End Sub

---

сокращенная версия выше:

Option Explicit
Public Sub GetInfo()
    Dim s As String, json As Object
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www1.hkex.com.hk/hkexwidget/data/getequityquote?sym=2&token=evLtsLsBNAUVTPxtGqVeG6jZbQlrF5FojHmveNua5GgTcjPuBcUs7GTV0hIBAgAI&lang=chi&qid=1560281438643&callback=jQuery311003616462678192556_1560281436567&_=1560281436568", False
        .send
        s = Split(Split(.responseText, "(")(1), ")")(0)
    End With
    Set json = JsonConverter.ParseJson(s)("data")("quote")
    With ThisWorkbook.Worksheets("Sheet1")
        .Cells(1, 1) = json("updatetime")
        .Cells(3, 2).Resize(1, 2) = Array(json("hi"), json("hi52"))
        .Cells(4, 2).Resize(1, 2) = Array(json("lo"), json("lo52"))
    End With
End Sub

Answer 2

Это немного отличается от вашего подхода, но он дает ожидаемый результат без циклического перебора строк:

Тем не менее, позженапечатанная строка может быть записана в список, поэтому с ней можно работать, если она отделена новой строкой, а пустые строки удалены:

Sub TestMe()

    Dim appIE As Object
    Set appIE = CreateObject("InternetExplorer.Application")

    With appIE
        .navigate "https://www.hkex.com.hk/Market-Data/Securities-Prices/Equities/Equities-Quote?sym=2&sc_lang=zh-hk"
        .Visible = False
    End With

    Do While appIE.Busy
        DoEvents
    Loop

    Dim allData As Object
    Set allData = appIE.document.getElementsByClassName("table_list")

    Debug.Print allData.item.outerText
    appIE.Close

End Sub