Webscraping в VBA некоторая информация HTML не имеет никакого способа сослаться на нее

Question

У меня есть этот сценарий VBA, и я работаю в блокировщике.

Я собираю вещи с этого URL https://accessgudid.nlm.nih.gov/devices/10806378034350 Все, что мне нужно, это информация LOT, SERIAL и EXPIRATIONкоторый вы можете видеть на рисунке ниже, имеет «Да» или «Нет» внутри HTML. Как заставить его вернуть только ту информацию Да или Нет?

Вот то, что у меня есть в настоящее время

    Sub GetInnerInformation(HTMLPage As MSHTML.HTMLDocument)
    Dim HTMLResult As MSHTML.IHTMLElement
    Dim HTMLResults As MSHTML.IHTMLElementCollection
    Dim HTMLRow As MSHTML.IHTMLElement
    Dim HTMLCell As MSHTML.IHTMLElement
    Dim RowNum As Long, ColNum As Integer

    Set HTMLResults = HTMLPage.getElementsByClassName("device-attribute")

    For Each HTMLResult In HTMLResults
        If (HTMLResult.innerText Like "*Lot*") = True Then
            Debug.Print HTMLResult.innerText, HTMLResult.outerText, HTMLResult.innerHTML
        End If
    Next HTMLResult

End Sub

Который в моем непосредственном окне я получаю это:

Lot or Batch Number:        Lot or Batch Number:        Lot or Batch Number:

Так что нет ссылки на «да» или «нет» в HTML с моей печатью там.

Интересно, есть ли у кого-нибудь понимание относительночто я делаю не так.

Заранее спасибо!

Answer 1

HTML Parser:

Вы можете использовать css attribute = селектор значения , чтобы нацелиться на span с [?], Который находится перед div представляет интерес. Затем поднимитесь к общему родителю с помощью parentElement и перейдите к интересующему div с помощью NextSibling. Затем вы можете использовать getElementsByTagName, чтобы получить узлы labels, и зациклить этот список узлов, чтобы записать необходимую информацию. Чтобы получить значения, связанные с метками, вам снова нужно использовать NextSibling для обработки br дочерних элементов в родительском div.

Я использую xmlhttp, чтобы выполнить запрос быстрее, чем открывать браузер. ,

Option Explicit   
Public Sub WriteOutYesNos()
    Dim html As MSHTML.HTMLDocument

    Set html = New MSHTML.HTMLDocument
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://accessgudid.nlm.nih.gov/devices/10806378034350", False
        .send
        html.body.innerHTML = .responseText
    End With

    Dim nodes As Object, i As Long

    Set nodes = html.querySelector("[title*='A production identifier (PI) is a variable']").parentElement.NextSibling.getElementsByTagName("LABEL")

    For i = 0 To nodes.Length - 3
        With ActiveSheet
            .Cells(i + 1, 1) = nodes(i).innerText
            .Cells(i + 1, 2) = nodes(i).NextSibling.NodeValue
        End With
    Next
End Sub

---

JSON Parser:

Данные также доступны как json, что означает, что вы можете использовать json parser для обработки. Я использую jsonconverter.bas в качестве парсера json для обработки ответа. Загрузите необработанный код из здесь и добавьте в стандартный модуль JsonConverter. Затем вам нужно перейти VBE> Инструменты> Ссылки> Добавить ссылку на Microsoft Scripting Runtime. Удалите верхнюю строку Attribute из скопированного кода.

Option Explicit   
Public Sub WriteOutYesNos()
    Dim json As Object, ws As Worksheet, results(), i As Long, s As String

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    results = Array("lotBatch", "serialNumber", "manufacturingDate")

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://accessgudid.nlm.nih.gov/devices/10806378034350.json", False
        .send
        Set json = JsonConverter.ParseJson(.responseText)
    End With

    With ws
        For i = LBound(results) To UBound(results)
            .Cells(i + 1, 1) = results(i)
            .Cells(i + 1, 2).Value = IIf(json(results(i)), "Yes", "No")
        Next
    End With
End Sub

---

Синтаксический анализатор XML:

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

Option Explicit
Public Sub WriteOutYesNos()
    Dim xmlDoc As Object, ws As Worksheet, results(), i As Long

    Set xmlDoc = CreateObject("MSXML2.DOMDocument")
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    results = Array("lotBatch", "serialNumber", "manufacturingDate")

    With xmlDoc
        .validateOnParse = True
        .setProperty "SelectionLanguage", "XPath"
        .setProperty "SelectionNamespaces", "xmlns:i='http://www.fda.gov/cdrh/gudid'"
        .async = False

        If Not .Load("https://accessgudid.nlm.nih.gov/devices/10806378034350.xml") Then
            Err.Raise .parseError.ErrorCode, , .parseError.reason
            Exit Sub
        End If
    End With

    With ws
        For i = LBound(results) To UBound(results)
            .Cells(i + 1, 1) = results(i)
            .Cells(i + 1, 2).Value = IIf(xmlDoc.SelectSingleNode("//i:" & results(i)).Text, "Yes", "No")
        Next
    End With
End Sub

Answer 2

Повозился и нашел его. Мне пришлось немного жестко закодировать результаты, но вот что я получил. Дайте мне знать, если вы нашли более элегантный ответ!

   Sub GetInnerInformation(HTMLPage As MSHTML.HTMLDocument)
        Dim HTMLResult As MSHTML.IHTMLElement
        Dim HTMLResults As MSHTML.IHTMLElementCollection
        Dim HTMLRow As MSHTML.IHTMLElement
        Dim HTMLCell As MSHTML.IHTMLElement
        Dim RowNum As Long, ColNum As Integer
        Dim Lot As Boolean
        Dim Serial As Boolean
        Dim Expiration As Boolean

        Set HTMLResults = HTMLPage.getElementsByClassName("expandable-device-content")

        For Each HTMLResult In HTMLResults
            If (HTMLResult.innerText Like "*Lot or Batch Number*") = True Then
                Debug.Print HTMLResult.innerText

                If HTMLResult.innerText Like "*Lot or Batch Number: Yes*" Then
                    Lot = True
                End If

                If HTMLResult.innerText Like "*Lot or Batch Number: No*" Then
                    Lot = False
                End If

                If HTMLResult.innerText Like "*Serial Number: Yes*" Then
                    Serial = True
                End If

                If HTMLResult.innerText Like "*Serial Number: No*" Then
                    Serial = False
                End If

                If HTMLResult.innerText Like "*Expiration Date: Yes*" Then
                    Serial = True
                End If

                If HTMLResult.innerText Like "*Expiration Date: No*" Then
                    Serial = False
                End If

                Debug.Print Lot, Serial, Expiration
            End If
        Next HTMLResult

    End Sub