Как анализировать XML в VBA и получать конкретные значения

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, но когда я пытаюсь найти один конкретный узел, результат кода - ничто.

in

Set xmlNodeList = xmlDoc.getElementsByTagName("*")

Я пытался использовать адрес "// AttributeDescription", но, видимо, просто работаю с использованием "*".

Мне нужно получить, например, ответ ниже:

AttributeDescription = Production

CountryName = Brazil

Value = 0.00000

Я приложил все усилия, чтобы получить правильный ответ, и я также считаю, что структура XMLэто не в правильном формате из-за отсутствия ответа при обращении ...

Могу ли я что-нибудь сделать, чтобы решить эту проблему?

Answer 1

Здесь есть две отдельные проблемы.

MSXML2 имеет проблемы с использованием XPath, когда XML-документ имеет пространство имен по умолчанию - подробности см. здесь . В начале скачанного документа с сайта USDA есть несколько объявлений пространства имен:

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

Здесь объявлено два пространства имен. Один с префиксом i и пространством имен по умолчанию, которое охватывает любой элемент, который не имеет префикса пространства имен. Если вы посмотрите на запись «CalendarYear» в XML-документе - <CalendarYear i:nil="true" /> - тогда вы увидите, что «CalendarYear» находится в пространстве имен по умолчанию, а «nil» - в пространстве имен «i».

КомуЧтобы MSXML2 работал с пространствами имен по умолчанию, вы должны объявить пространство имен, которое имеет тот же URI, что и пространство имен по умолчанию. Это делается с помощью свойства SelectionNamespaces документа XML, например:

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

Это решение возвращает следующий ответ в отладчике:

Производство

Аргентина

55300.0000

Именно то, что я хотел.

Еще раз спасибо за время и за обмен знаниями.