如何在VBA中使用MSXML按标记名提取单个HTML元素的文本？

我正在尝试使用MSXML6提取美国专利权

在美国专利商标局网站上的专利文件的全文html视图中，专利标题显示为第一个也是唯一一个“字体”元素，它是“body”的子元素

这是我的函数不起作用（我没有得到任何错误；公式所在的单元格保持空白）

有人能帮我找出是什么问题吗

我输入函数的一个示例URL是

函数getUSPatentTitle（url为字符串） 静态colTitle作为新集合 将标题设置为字符串 将pageSource设置为字符串 Dim xDoc作为MSXML2.DOMDocument 将xNode设置为IXMLDOMNode 出错时继续下一步 title=colTitle（url） 如果错误号为0，则 设置html_doc=CreateObject（“htmlfile”） 设置xml_obj=CreateObject（“MSXML6.XMLHTTP60”） xml_obj.Open“GET”，url，False xml_obj.send pageSource=xml_obj.responseText 设置xml_obj=Nothing Set xDoc=New MSXML2.DOMDocument 如果不是xDoc.LoadXML（pageSource），则 Err.Raise xDoc.parseError.ErrorCode，xDoc.parseError.reason 如果结束 设置xNode=xDoc.getElementsByTagName（“字体”）。项（1） title=xNode.Text 如果不是title=“”，则colTitle.Add项：=标题，键：=url 如果结束 关于错误GoTo 0'我理解“GoTo”是危险的编码，但它是从某人那里复制的，到目前为止还没有想到一个更自然的替代GoTo语句 getUSPatentTitle=标题 端函数 只有几点：

• “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

函数getUSPatentTitle（url为字符串） 静态colTitle作为新集合 将标题设置为字符串 将pageSource设置为字符串 Dim errorNumber为整数 出错时继续下一步 title=colTitle（url） errorNumber=错误编号 错误转到0 如果错误号为0，则 Dim xml_obj作为XMLHTTP60 设置xml_obj=CreateObject（“MSXML2.XMLHTTP”） xml_obj.Open“GET”，url，False xml_obj.send pageSource=xml_obj.responseText 设置xml_obj=Nothing 作为HTMLDocument的Dim html\u文档 设置html_doc=CreateObject（“HTMLFile”） html\u doc.body.innerHTML=pageSource 作为IHTMLElement的Dim fontElement Set fontElement=html_doc.getElementsByTagName（“字体”）。项（3） title=fontElement.innerText 如果不是title=“”，则colTitle.Add项：=标题，键：=url 如果结束 getUSPatentTitle=标题 端函数

---

CSS选择器：

您可以重新编写所描述的内容，它实际上是

正文

标记中作为CSS选择器的第一个

字体

标记：

body > font

---

CSS查询：

---

VBA:

由于它是第一个匹配项/只有您需要，您可以使用

document

的

querySelector

方法应用选择器并检索单个元素

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

---

您可能需要添加对

HTML对象库的引用

，并使用

Dim HTML\u doc As HTMLDocument

的早期绑定调用来访问该方法。后期绑定方法可能会公开

querySelector

方法，但如果接口没有使用早期绑定。

谢谢codersl-我必须添加一个参考：工具>参考>Microsoft HTML对象库，它可以工作。我知道有更早的“字体”元素，但一直试图在“body”下找到第一个，却忘了更改索引。我还看到它显然是零基的。VBA中没有类似于Java中Jsoup方法的“select”方法吗？我可以说类似于

Element=Document.select（“html>body>font”）.get（0）

？在这种情况下，这样做会更好，因为有时在标题上方，但在表中，可能还有一个“font”元素。不幸的是，我不知道VBA中有等效的“select”方法。

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