1

我正在尝试使用 MSXML6 提取美国专利标题。

在 USPTO 网站上专利文档的全文 html 视图中，专利标题显示为第一个也是唯一一个作为“body”子元素的“font”元素。

这是我的函数不起作用（我没有收到错误；带有公式的单元格只是保持空白）。

有人可以帮我找出问题所在吗？

我输入函数的示例 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
4

2 回答 2

1

只是几点：

  • “On Error Goto 0”并不是真正的传统 Goto 语句——它只是在 VBA 中关闭用户错误处理的方式。您的代码中有一些错误，但“On Error Resume Next”跳过了它们，因此您什么也看不到。

  • 来自网页的数据是 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
于 2015-10-27T07:10:12.313 回答
1

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方法，但如果接口不公开，则使用早期绑定。

于 2018-06-30T15:47:34.620 回答