如何在VBA中使用MSXML2通过含文本的XPath定位元素？

需要在VBA中借助MSXML2内置库通过XPath获取网页元素，遇到两个问题：

1. 旧论坛找到的getXPathElement()函数仅支持绝对路径（如/html/body/div[4]/div/div/a[3]），无法处理包含文本条件的XPath（如//a[text()[contains(.,'HTML Editors')]]）。
2. 改用MSXML2.DOMDocument的SelectNodes()方法时出现运行时错误，相关代码如下：

当前代码 #

Sub Main()
Dim url As String
Dim oHttp As New MSXML2.XMLHTTP60
Dim elem As HTMLBaseElement


    url = "https://www.w3schools.com/html/"
    oHttp.Open "GET", url, False
    oHttp.send
    
    Dim html As New HTMLDocument
    html.body.innerHTML = oHttp.responseText
    Set elem = getXPathElement("/html/body/div[4]/div/div/a[3]", html)

    ' ### with this xpath doesn´t work
    'Set elem = getXPathElement("//a[text()[contains(.,'HTML Editors')]]", html) 

    Debug.Print elem.innerText
    
End Sub

Public Function getXPathElement(sXPath As String, objElement As Object) As HTMLBaseElement
     Dim sXPathArray() As String
 
    Dim sNodeName As String
     Dim sNodeNameIndex As String
     Dim sRestOfXPath As String
     Dim lNodeIndex As Long
     Dim lCount As Long
 
    ' Split the xpath statement
     sXPathArray = Split(sXPath, "/")
     sNodeNameIndex = sXPathArray(1)
     If Not InStr(sNodeNameIndex, "[") > 0 Then
         sNodeName = sNodeNameIndex
         lNodeIndex = 1
     Else
         sXPathArray = Split(sNodeNameIndex, "[")
         sNodeName = sXPathArray(0)
         lNodeIndex = CLng(Left(sXPathArray(1), Len(sXPathArray(1)) - 1))
     End If
     sRestOfXPath = Right(sXPath, Len(sXPath) - (Len(sNodeNameIndex) + 1))
 
    Set getXPathElement = Nothing
     For lCount = 0 To objElement.ChildNodes().Length - 1
         If UCase(objElement.ChildNodes().Item(lCount).nodeName) = UCase(sNodeName) Then
             If lNodeIndex = 1 Then
                 If sRestOfXPath = "" Then
                     Set getXPathElement = objElement.ChildNodes().Item(lCount)
                 Else
                     Set getXPathElement = getXPathElement(sRestOfXPath, objElement.ChildNodes().Item(lCount))
                 End If
             End If
             lNodeIndex = lNodeIndex - 1
         End If
     Next lCount
 End Function

更新后的代码 #

Sub Main()
Dim url As String
Dim oHttp As New MSXML2.XMLHTTP60
Dim elem As MSXML2.IXMLDOMNode


    url = "https://www.w3schools.com/html/"
    oHttp.Open "GET", url, False
    oHttp.send
    
    Dim html As New HTMLDocument
    html.body.innerHTML = oHttp.responseText
    
    Set doc = New MSXML2.DOMDocument60
    doc.SetProperty "SelectionLanguage", "XPath"
    doc.Load oHttp.responseText
    
    Set elem = doc.SelectNodes("//a[text()[contains(.,'HTML Editors')]")
    
End Sub

核心错误点 #

1. XPath语法错误：你的XPath表达式末尾缺少一个闭合括号，正确写法应为//a[text()[contains(.,'HTML Editors')]]。
2. HTML解析兼容性问题：MSXML2.DOMDocument默认按XML规则解析，直接加载HTML文本会因HTML的非标准语法（如未闭合标签）导致解析失败，无法识别节点。
3. 对象类型不匹配：SelectNodes()返回的是IXMLDOMNodeList节点集合，而非单个IXMLDOMNode，直接赋值给单个节点变量会触发类型错误。

修正后的代码 #

Sub Main()
    Dim url As String
    Dim oHttp As New MSXML2.XMLHTTP60
    Dim elemList As MSXML2.IXMLDOMNodeList
    Dim elem As MSXML2.IXMLDOMNode
    
    url = "https://www.w3schools.com/html/"
    oHttp.Open "GET", url, False
    oHttp.send
    
    ' 配置DOMDocument支持HTML解析
    Set doc = New MSXML2.DOMDocument60
    doc.SetProperty "SelectionLanguage", "XPath"
    doc.SetProperty "ProhibitDTD", False ' 允许DTD，避免HTML解析报错
    doc.async = False
    doc.loadXML oHttp.responseText ' 用loadXML加载文本，而非Load（Load用于加载文件）
    
    ' 修正XPath语法，获取节点集合
    Set elemList = doc.SelectNodes("//a[text()[contains(.,'HTML Editors')]]")
    
    ' 遍历集合获取目标元素
    If elemList.Length > 0 Then
        Set elem = elemList(0)
        Debug.Print elem.Text ' DOMDocument中用Text而非innerText
    Else
        Debug.Print "未找到匹配元素"
    End If
End Sub

可选方案：结合HTMLDocument解析 #

如果需要使用HTMLDocument的innerText等便利属性，可以先通过HTMLDocument处理非标准HTML，再转换为DOMDocument执行XPath：

Sub MainWithHTMLDoc()
    Dim url As String
    Dim oHttp As New MSXML2.XMLHTTP60
    Dim htmlDoc As New HTMLDocument
    Dim xmlDoc As New MSXML2.DOMDocument60
    Dim elemList As MSXML2.IXMLDOMNodeList
    Dim elem As HTMLAnchorElement
    
    url = "https://www.w3schools.com/html/"
    oHttp.Open "GET", url, False
    oHttp.send
    
    ' 先用HTMLDocument解析非标准HTML
    htmlDoc.body.innerHTML = oHttp.responseText
    
    ' 将HTMLDocument转换为DOMDocument以支持XPath
    xmlDoc.LoadXML htmlDoc.DocumentElement.outerHTML
    xmlDoc.SetProperty "SelectionLanguage", "XPath"
    
    Set elemList = xmlDoc.SelectNodes("//a[text()[contains(.,'HTML Editors')]]")
    If elemList.Length > 0 Then
        ' 通过ID转换回HTML元素（如果元素有ID），或直接遍历HTMLDocument节点
        Set elem = htmlDoc.querySelector("//a[text()[contains(.,'HTML Editors')]]")
        Debug.Print elem.innerText
    End If
End Sub

内容的提问来源于stack exchange，提问作者Rasec Malkic