Как получить внутренний текст HTML под идентификатором?

Question

Я пытаюсь получить данные, извлеките внутренний текст под идентификатором в ячейке Excel.

Это для XML-кода.

Sub getelementbyid()
Dim XMLpage As New MSXML2.XMLHTTP60
Dim hdoc As New MSHTML.HTMLDocument
Dim HBEs As MSHTML.IHTMLElementCollection
Dim HBE As MSHTML.IHTMLElement
Dim ha As String
XMLpage.Open "GET","https://www.nseindia.com/live_market/dynaContent/live_watch/get_quote/GetQuote.jsp?symbol=HAL", False
XMLpage.send
hdoc.body.innerHTML = XMLpage.responseText
ha = hdoc.getelementbyid("open").innerText
Range("K11").Value = ha
Debug.Print ha
End Sub

Я ожидаю выходное значение, но оно показывает -.

Answer 1

Изучите текст ответа.Существует разница в способе отображения страницы в браузере по сравнению с тем, что возвращается в ResponseText.

Я поместил URL в браузер, зашел в инструменты разработчика (F12), нашел элемент и заметил числовое значение внутри элемента HTML.

Затем я выкинул текст ответа, который мыпопасть в VBA в ячейку и скопировать все значение ячейки в Notepad ++.Если вы сделаете это, вы увидите, что начальное значение внутри элемента #open действительно "-".

Похоже, что реальная ценность заключается в том, чтобы записываться в HTML через JavaScript, что является обычной практикой.В верхней части страницы находится объект JSON, предположительно внедренный в документ из серверной части веб-сайта по вашему запросу.

Таким образом, вы должны анализировать JSON, а не HTML.Я предоставил код, делающий именно это.Теперь, возможно, есть лучший способ сделать это, я чувствую, что этот код вроде «хакерский», но он выполняет свою работу для вашего примера URL.

Sub getelementbyid()
    Dim XMLpage As New MSXML2.XMLHTTP60
    Dim hdoc As New MSHTML.HTMLDocument

    Dim HBEs As MSHTML.IHTMLElementCollection
    Dim HBE As MSHTML.IHTMLElement
    Dim ha As String
    XMLpage.Open "GET", "https://www.nseindia.com/live_market/dynaContent/live_watch/get_quote/GetQuote.jsp?symbol=HAL", False
    XMLpage.send

    '// sample: ,"open":"681.05",
    Dim token As String
    token = """open"":"""

    Dim startPosition As Integer
    startPosition = InStr(1, XMLpage.responseText, token)

    Dim endPosition As Integer
    endPosition = InStr(startPosition, XMLpage.responseText, ",")

    Dim prop As String
    prop = Mid(XMLpage.responseText, startPosition, endPosition - startPosition)
    prop = Replace(prop, """", vbNullString)
    prop = Replace(prop, "open:", vbNullString)

    Dim val As Double
    val = CDbl(prop)
    ha = val

    Range("K11").Value = ha
    Debug.Print ha
End Sub

Answer 2

Вот два метода.1) Использование регулярного выражения в возвращаемом тексте.Обычно хмурится, но здесь вполне исправно.2) Традиционное извлечение строки json и использование парсера json для анализа значения.

Требуемые данные хранятся в строке json, найденной как на веб-странице, так и в ответе xmlhtttp , под тем же самымэлемент:

Это означает, что вы можете рассматривать html как строку и нацеливать только образец цены открытия, используя регулярное выражение, как показано ниже, или анализироватьзапрос xmlhttp в html-парсер, возьмите требуемый элемент, извлеките его innerText и обрежьте пробел, затем перейдите к json-парсеру для извлечения цены открытия.

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

.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"

Нет необходимости в дополнительном форматировании ячейки.Полное значение получается для обоих тикеров.

---

Регулярное выражение:

Оно присутствует в строке json в ответе.Вы можете легко вывести его из текста возврата.

---

Объяснение Regex:

---

VBA:

Option Explicit
Public Sub GetClosePrice()
    Dim ws As Worksheet, re As Object, p As String, r As String

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    p = """open"":""(.*?)"""
    Set re = CreateObject("VBScript.RegExp")

    With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", "https://www.nseindia.com/live_market/dynaContent/live_watch/get_quote/GetQuote.jsp?symbol=HAL", False
            .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
            .send
            If .Status = 200 Then
                r = GetValue(re, .responseText, p)
            Else
                r = "Failed connection"
            End If
    End With
    ws.Range("K11").Value = r
End Sub

Public Function GetValue(ByVal re As Object, ByVal inputString As String, ByVal pattern As String) As String
    With re
        .Global = True
        .pattern = pattern
        If .test(inputString) Then  ' returns True if the regex pattern can be matched agaist the provided string
            GetValue = .Execute(inputString)(0).submatches(0)
        Else
            GetValue = "Not found"
        End If
    End With
End Function

---

Анализатор HTML и json:

Для этого требуется установить код для jsonparser из jsonconverter.bas в стандартный модуль с именем JsonConverter, а затем перейти в VBE> Инструменты> Ссылки> Добавить ссылку на Microsoft Scripting Runtime иБиблиотека объектов Microsoft HTML.

VBA:

Option Explicit

Public Sub GetClosePrice()
    Dim ws As Worksheet, re As Object, r As String, json As Object

    Set ws = ThisWorkbook.Worksheets("Sheet1")

    With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", "https://www.nseindia.com/live_market/dynaContent/live_watch/get_quote/GetQuote.jsp?symbol=MRF", False
            .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
            .send
            If .Status = 200 Then
                Dim html As HTMLDocument
                Set html = New HTMLDocument
                html.body.innerHTML = .responseText
                Set json = JsonConverter.ParseJson(Trim$(html.querySelector("#responseDiv").innerText))
                r = json("data")(1)("open")
            Else
                r = "Failed connection"
            End If
    End With
    ws.Range("K11").Value = r
End Sub