Как извлечь текст одного элемента HTML по имени тега с помощью MSXML в VBA?

Я пытаюсь извлечь названия патентов США, используя MSXML6.

В полнотекстовом HTML-представлении патентного документа на веб-сайте USPTO название патента отображается как первый и единственный элемент «шрифт», который является дочерним элементом «тела».

Вот моя функция, которая не работает (я не получаю ошибки, просто ячейка с формулой остается пустой).

Может ли кто-нибудь помочь мне понять, что не так?

Пример URL-адреса, который я передаю в функцию: http://patft.uspto.gov/netacgi/nph-Parser?Sect1=PTO1&Sect2=HITOFF&d=PALL&p=1&u=%2Fnetahtml%2FPTO%2Fsrchnum.htm&r=1&f=G&l=50&s1=6293874.PN.&OS=PN/6293874&RS=PN/6293874

Function getUSPatentTitle(url As String)
    Static colTitle As New Collection
    Dim title As String
    Dim pageSource As String

    Dim xDoc As MSXML2.DOMDocument
    Dim xNode As IXMLDOMNode

    On Error Resume Next

    title = colTitle(url)
    If Err.Number <> 0 Then
        Set html_doc = CreateObject("htmlfile")
        Set xml_obj = CreateObject("MSXML6.XMLHTTP60")

        xml_obj.Open "GET", url, False
        xml_obj.send
        pageSource = xml_obj.responseText
        Set xml_obj = Nothing

        Set xDoc = New MSXML2.DOMDocument
        If Not xDoc.LoadXML(pageSource) Then  
            Err.Raise xDoc.parseError.ErrorCode, , xDoc.parseError.reason
        End If

        Set xNode = xDoc.getElementsByTagName("font").Item(1)

        title = xNode.Text
        If Not title = "" Then colTitle.Add Item:=title, Key:=url
    End If

    On Error GoTo 0 ' I understand "GoTo" is dangerous coding but copied from somebody and so far haven't thought of a more natural substitute for a GoTo statement

    getUSPatentTitle = title
End Function

html vba msxml msxml6
person PatentWookiee    schedule 26.10.2015    source источник

Ответы (2)


arrow_upward
1
arrow_downward

Всего несколько моментов:

  • «On Error Goto 0» на самом деле не является традиционным оператором Goto — это просто то, как вы отключаете обработку ошибок пользователя в VBA. В вашем коде было несколько ошибок, но «Возобновить при ошибке дальше» их пропустили, поэтому вы ничего не увидели.

  • Данные с веб-страницы представлены в формате HTML, а не XML.

  • Перед заголовком было несколько «шрифтовых» элементов.

Это должно работать:

Function getUSPatentTitle(url As String)
    Static colTitle As New Collection
    Dim title As String
    Dim pageSource As String
    Dim errorNumber As Integer

    On Error Resume Next
    title = colTitle(url)
    errorNumber = Err.Number
    On Error GoTo 0

    If errorNumber <> 0 Then
        Dim xml_obj As XMLHTTP60
        Set xml_obj = CreateObject("MSXML2.XMLHTTP")
        xml_obj.Open "GET", url, False
        xml_obj.send
        pageSource = xml_obj.responseText
        Set xml_obj = Nothing

        Dim html_doc As HTMLDocument
        Set html_doc = CreateObject("HTMLFile")
        html_doc.body.innerHTML = pageSource

        Dim fontElement As IHTMLElement
        Set fontElement = html_doc.getElementsByTagName("font").Item(3)

        title = fontElement.innerText
        If Not title = "" Then colTitle.Add Item:=title, Key:=url
    End If

    getUSPatentTitle = title
End Function
person codersl    schedule 27.10.2015
comment
Спасибо codersl - мне пришлось добавить ссылку: Инструменты › Ссылки › Microsoft HTML Object Library, и это работает. Я знал, что есть более ранние элементы шрифта, но пытался найти первый прямо под телом и забыл изменить индекс. Также я вижу, что это, по-видимому, основано на нуле. Разве в VBA нет метода select, аналогичного методу Jsoup в Java, где я мог бы сказать что-то вроде Element element = Document.select("html > body > font").get(0) ? В данном случае это сработало бы лучше, потому что иногда над заголовком может быть еще один элемент шрифта, но внутри таблицы. - person PatentWookiee; 28.10.2015
comment
К сожалению, я не знаю эквивалентного метода выбора в VBA. - person codersl; 29.10.2015

arrow_upward
1
arrow_downward

Селектор CSS:

Вы можете переписать то, что вы описали, что на самом деле является первым тегом font внутри тега body в качестве селектора CSS:

body > font

CSS-запрос:

Селектор CSS

VBA:

Поскольку это первое совпадение/только вам нужно, вы можете использовать метод querySelector из document, чтобы применить селектор и получить один элемент.

Debug.Print html_doc.querySelector("body > font").innerText

Возможно, вам потребуется добавить ссылку на HTML Object Library и использовать ранний связанный вызов Dim html_doc As HTMLDocument для доступа к методу. Метод поздней привязки может предоставлять метод querySelector, но если интерфейс не использует раннюю привязку.

person QHarr    schedule 30.06.2018