如何在 VBA 中解析 XML 并检索特定值

Question

我已经花了两周时间搜索如何解析一个特定的 XML 并只获取几个值，但没有成功。我已经尝试了互联网上的每一个代码，直到找到一个可以解决部分问题的代码。

我试图从美国农业部获取的 XML，可以免费访问。

https://apps.fas.usda.gov/psdonline/app/index.html#/app/about

    Dim xmlDoc As MSXML2.DOMDocument60
    Dim xmlNode As MSXML2.IXMLDOMNode
    Dim xmlNodeList As MSXML2.IXMLDOMNodeList
    Dim myNode As MSXML2.IXMLDOMNode

    Dim URL As String, APIkey As String

    APIkey = "8DB688F8-1E22-4031-B581-59C221ECDDA6"

    URL = "https://apps.fas.usda.gov/PSDOnlineDataServices/api/CommodityData/GetCommodityDataByYear?commodityCode=2222000&marketYear=2018"

    Set xmlDoc = New MSXML2.DOMDocument60
    xmlDoc.async = False

    With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", URL, False
    .SetRequestHeader "Accept", "text/xml"
    .SetRequestHeader "API_KEY", APIkey
    .Send
    xmlDoc.loadXML .ResponseText
End With

Set xmlNodeList = xmlDoc.getElementsByTagName("*")
    For Each xmlNode In xmlNodeList
        For Each myNode In xmlNode.childNodes
          If myNode.nodeType = NODE_TEXT Then
            Debug.Print xmlNode.nodeName & "=" & xmlNode.text
          End If
        Next myNode
    Next xmlNode
    Set xmlDoc = Nothing
End Sub

此代码的响应显示列出的整个 XML，但是当我尝试查找一个特定节点时，代码结果什么都没有。

在

Set xmlNodeList = xmlDoc.getElementsByTagName("*")

我尝试使用地址“//AttributeDescription”，但显然只能使用“*”。

例如，我需要收到以下响应：

AttributeDescription=生产

CountryName=巴西

值=0.00000

我尽了最大努力获得正确的响应，我还认为 XML 结构的格式不正确，因为在寻址时缺少响应...

有什么办法可以解决这个问题吗？

Answer 1

这里有两个不同的问题。

当 XML 文档具有默认命名空间时，MSXML2 使用 XPath 会出现问题 - 有关详细信息，请参阅 here。在从 USDA 网站下载的文档的开头，有一些命名空间声明：

<ArrayOfCommodityData xmlns:i="http://www.w3.org/2001/XMLSchema-instance" xmlns="http://schemas.datacontract.org/2004/07/PSDOnline.DataServices.Models">

这里声明了两个命名空间。一个带有前缀 i 和一个默认命名空间，该命名空间涵盖任何没有命名空间前缀的元素。如果您查看 XML 文档中的“CalendarYear”条目 - <CalendarYear i:nil="true" /> - 那么您可以看到“CalendarYear”在默认命名空间中，而“nil”在“i”命名空间中。

要使 MSXML2 使用默认命名空间，您必须声明一个与默认命名空间具有相同 URI 的命名空间。这是使用 XML 文档的 SelectionNamespaces 属性完成的，如下所示：

xmlDoc.SetProperty "SelectionNamespaces", "xmlns:r='http://schemas.datacontract.org/2004/07/PSDOnline.DataServices.Models'"

我选择 r 作为命名空间，但您选择的名称无关紧要 - 它必须与文档中的任何其他命名空间不同。

这就引出了第二个问题。您正在使用 getElementsByTagName ，它仅将标记名称作为参数，但您传入的是 XPath 字符串。要处理 XPath 字符串，您需要改用SelectNodes，并且需要使用我们添加的命名空间，如下所示：

Set xmlNodeList = xmlDoc.SelectNodes("//r:AttributeDescription")

Answer 2

我认为这是一个命名空间问题。有更熟悉这一点的人可能会修复如何正确添加然后参考。我确实尝试使用通常的语法 .setProperty "SelectionNamespaces", namespace 添加两个命名空间，但仍然无法设置对象，所以我猜我做错了什么。

一个临时的、不太可靠的解决方案如下：

Option Explicit
Public Sub test()
    Dim xmlDoc As MSXML2.DOMDocument60
    Dim URL As String, APIkey As String

    APIkey = "key"

    URL = "https://apps.fas.usda.gov/PSDOnlineDataServices/api/CommodityData/GetCommodityDataByYear?commodityCode=2222000&marketYear=2018"

    Set xmlDoc = New MSXML2.DOMDocument60

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .SetRequestHeader "Accept", "text/xml"
        .SetRequestHeader "API_KEY", APIkey
        .Send
        xmlDoc.LoadXML .responseText
    End With

    Dim node As IXMLDOMElement, r As Long
    For Each node In xmlDoc.SelectNodes("/*[name()='ArrayOfCommodityData']/*[name()='CommodityData']")
        r = r + 1
        With ActiveSheet
            .Cells(r, 1) = node.ChildNodes(0).Text
            .Cells(r, 2) = node.ChildNodes(6).Text
            .Cells(r, 3) = node.ChildNodes(11).Text
        End With
    Next
End Sub

Answer 3

我已经找到了这个解决方案，混合了两个答案，并分享了代码以帮助其他人。

首先我设置属性，然后使用迭代来检索我需要的值，我不知道这是否是最好的解决方案，因为我无法控制 XML 结构，如果他们改变了他们的文件，我会需要返回这段代码。

我尝试在“安全线”中工作以避免输出中的任何错误，但由于我可以访问数据本身，因此我可以仔细检查。

If node.childNodes(0).text = "Production" And node.childNodes(6).text = "Argentina" Then

为了确保名字和响应会带来我想要的任何东西。

Public Sub test_3()
    Dim xmlDoc As MSXML2.DOMDocument60
    Dim URL As String, APIkey As String

    APIkey = "8DB688F8-1E22-4031-B581-59C221ECDDA6"

    URL = "https://apps.fas.usda.gov/PSDOnlineDataServices/api/CommodityData/GetCommodityDataByYear?commodityCode=2222000&marketYear=2018"

    Set xmlDoc = New MSXML2.DOMDocument60

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .SetRequestHeader "Accept", "text/xml"
        .SetRequestHeader "API_KEY", APIkey
        .Send
        xmlDoc.loadXML .ResponseText
        xmlDoc.SetProperty "SelectionNamespaces", "xmlns:r='http://schemas.datacontract.org/2004/07/PSDOnline.DataServices.Models'"
    End With

    Dim node As IXMLDOMElement, r As Long

    For Each node In xmlDoc.selectNodes("//r:CommodityData")
        If node.childNodes(0).text = "Production" And node.childNodes(6).text = "Argentina" Then
        r = r + 1
        Debug.Print node.childNodes(0).text
        Debug.Print node.childNodes(6).text
        Debug.Print node.LastChild.text
        'With ActiveSheet
            '.Cells(r, 1) = node.childNodes(0).text
            '.Cells(r, 2) = node.childNodes(6).text
            '.Cells(r, 3) = node.LastChild.text
        'End With
        End If
    Next
End Sub

此解决方案在 DEBUGGER 中返回以下响应：

生产

阿根廷

55300.0000

正是我想要的。

再次感谢您抽出宝贵时间分享知识。