如何在VBA中使用DOMDocument解析XML并获取指定节点值

问题场景 #

需要从以下XML文档中获取ShipmentPIN下的Value节点值：

<s:Envelope xmlns:s="http://schemas.xmlsoap.org/soap/envelope/">
    <s:Header> 
        <h:ResponseContext xmlns:h="http://purolator.com/pws/datatypes/v2" xmlns:i="http://www.w3.org/2001/XMLSchema-instance">
            <h:ResponseReference>UserRef</h:ResponseReference>
        </h:ResponseContext>
    </s:Header>
    <s:Body>
        <CreateShipmentResponse xmlns="http://purolator.com/pws/datatypes/v2" xmlns:i="http://www.w3.org/2001/XMLSchema-instance">
            <ResponseInformation>
                <Errors/>
                <InformationalMessages i:nil="true"/>
            </ResponseInformation>
            <ShipmentPIN>
                <Value>329035959744</Value> <!-- 目标节点 -->
            </ShipmentPIN>
            <PiecePINs>
                <PIN>
                    <Value>329035959744</Value>
                </PIN>
                <PIN>
                    <Value>329035959751</Value>
                </PIN>
            </PiecePINs>
        </CreateShipmentResponse>
    </s:Body>
</s:Envelope>

尝试过的错误代码 #

运行后无返回结果的VBA代码：

Set response = CreateObject("MSXML2.DOMDocument")
response.SetProperty "SelectionLanguage", "XPath"
response.Async = False
response.validateOnParse = False
response.Load(respPath)

Set nodeXML = xmlDoc.getElementsByTagName("Value")
For i = 0 To nodeXML.Length - 1
    Debug.Print nodeXML(i).Text
Next

问题分析 #

1. 变量名不匹配：代码中创建的对象是response，但调用方法时用了未定义的xmlDoc，导致节点获取失败。
2. 命名空间未处理：目标节点所在的CreateShipmentResponse属于http://purolator.com/pws/datatypes/v2命名空间，直接用getElementsByTagName无法匹配到节点。

正确解决方案 #

方案一：命名空间映射+XPath精准定位（推荐） #

通过映射命名空间前缀，用XPath直接定位目标节点：

Sub GetShipmentPINValue()
    Dim xmlDoc As Object
    Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0") '使用高版本提升稳定性
    xmlDoc.SetProperty "SelectionLanguage", "XPath"
    '映射命名空间：前缀p对应目标命名空间
    xmlDoc.SetProperty "SelectionNamespaces", "xmlns:p='http://purolator.com/pws/datatypes/v2'"
    xmlDoc.Async = False
    xmlDoc.validateOnParse = False
    
    Dim respPath As String
    respPath = "你的XML文件路径" '替换为实际文件路径
    If xmlDoc.Load(respPath) Then
        Dim targetNode As Object
        '用XPath定位ShipmentPIN下的Value节点
        Set targetNode = xmlDoc.SelectSingleNode("//p:ShipmentPIN/p:Value")
        If Not targetNode Is Nothing Then
            Debug.Print "ShipmentPIN值：" & targetNode.Text
        Else
            Debug.Print "未找到目标节点"
        End If
    Else
        Debug.Print "XML加载错误：" & xmlDoc.parseError.reason
    End If
End Sub

方案二：忽略命名空间，遍历筛选 #

如果不想处理命名空间，可遍历所有节点并通过父节点判断目标：

Sub GetShipmentPINValueWithoutNS()
    Dim xmlDoc As Object
    Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")
    xmlDoc.Async = False
    xmlDoc.validateOnParse = False
    
    Dim respPath As String
    respPath = "你的XML文件路径"
    If xmlDoc.Load(respPath) Then
        Dim nodeList As Object, node As Object
        Set nodeList = xmlDoc.getElementsByTagName("*")
        For Each node In nodeList
            '判断节点为Value且父节点是ShipmentPIN
            If node.LocalName = "Value" And node.ParentNode.LocalName = "ShipmentPIN" Then
                Debug.Print "ShipmentPIN值：" & node.Text
                Exit For '找到目标后退出循环
            End If
        Next node
    Else
        Debug.Print "XML加载错误：" & xmlDoc.parseError.reason
    End If
End Sub

关键修正点 #

• 统一变量名，确保对象引用一致
• 处理XML命名空间，这是节点匹配失败的核心原因
• 推荐使用MSXML2.DOMDocument.6.0版本，兼容性和稳定性更佳

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