VBA按属性名选择XML元素val

I've been searching SO (and the rest of the Internet) for the answer, but I can't seem to find a solution for selecting an XML node based on an attribute.
This is my XML below this is for placing productcategoryid from a REST service XML

我一直在搜索SO(以及Internet的其他部分)来寻找答案，但我似乎找不到基于属性选择XML节点的解决方案。下面是我的XML，用于从REST服务XML中放置productcategoryid

  <lst name="responseHeader">
    <int name="status">0</int>
    <int name="QTime">0</int>
    <lst name="params">
      <str name="q">*:*</str>
      <str name="indent">true</str>
      <str name="wt">xml</str>
    </lst>
  </lst>

  <result name="response" numFound="5429" start="0">
    <doc>
      <int name="idProductCategory">2</int>
      <str name="categoryname">Live Animals</str>
      <int name="categoryLevel">2</int>
      <str name="bestOfferEnabled">false</str>
      <str name="leafCategory">true</str>
      <int name="parentCategoryId">1</int>
      <long name="_version_">1535190804282212352</long>
    </doc>
  </result>

</response>

I need to get the element of idProductCategory, i.e. 2, through VBA code, but I can't make it from below code.

我需要通过VBA代码获得idProductCategory的元素，即2，但是我不能从下面的代码中得到它。

 Sub getProductCategory(prodCatName As String)
    Dim result1 As String
    Dim result As String
    Dim myURL As String
    Dim winHttpReq As Object

    Set winHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")

    myURL = "http://localhost:8080/solr/category/select?q=" & prodCatName & "&wt=json"

    MsgBox myURL

    winHttpReq.Open "GET", myURL, False
    winHttpReq.Send

    MsgBox winHttpReq.responseText

    Dim doc_XML As DOMDocument60
    Set doc_XML = New DOMDocument60
    result = winHttpReq.responseText
    doc_XML.Load result

    Set List = doc_XML.documentElement.childNodes
    For Each sub_list In List
        If sub_list.Attributes(0).Text = "response" Then
            For Each Node In sub_list.childNodes(0).childNodes
                If Node.Attributes(0).Text = "idProductCategory" Then
                    result1 = Node.nodeTypedValue
                End If
            Next Node
        End If
    Next sub_list

End Sub

So please help me, I'm struggling on this I need to get element value by attribute name from this above XML and place it in a particular cell in Excel.

请帮助我，我在这个问题上很纠结我需要从上面的XML中获取元素值并将它放在Excel中的一个特定单元格中。

2 个解决方案

#1

This code works, it is less elegant than the query you tried to use, but IMO it is easier to understand, as working with xml can be a bit confusing.

这段代码是有效的，它没有您尝试使用的查询那么优雅，但是在我看来，它更容易理解，因为使用xml可能有点令人困惑。

Sub prueba2()
Dim doc_XML As DOMDocument60

Set doc_XML = New DOMDocument60

data = winHttpReq.responseText
doc_XML.Load data

Set List = doc_XML.DocumentElement.ChildNodes
For Each sub_list In List
    If sub_list.Attributes(0).Text = "response" Then
        For Each Node In sub_list.ChildNodes(0).ChildNodes
            If Node.Attributes(0).Text = "idProductCategory" Then
                result = Node.nodeTypedValue
            End If
        Next Node
    End If
Next sub_list
End Sub

The xml example used was:

使用的xml示例是:

<response>
<lst name="responseHeader">
  <int name="status">0</int>
  <int name="QTime">0</int>
  <lst name="params">
    <str name="q">*:*</str>
    <str name="indent">true</str>
    <str name="wt">xml</str>
  </lst>
</lst>
<result name="response" numFound="5429" start="0">
  <doc>
    <int name="idProductCategory">2</int>
    <str name="categoryname">Live Animals</str>
    <int name="categoryLevel">2</int>
    <str name="bestOfferEnabled">false</str>
    <str name="leafCategory">true</str>
    <int name="parentCategoryId">1</int>
    <long name="_version_">1535190804282212352</long>
  </doc>
</result>
</response>

#2

Using SelectSingleNode the code could look like this. HTH

使用SelectSingleNode，代码可以像这样。HTH

' Add reference to Microsoft XML v6.0 library

Public Const XML As String = _
    "<response>" & _
    "<lst name='responseHeader'>" & _
      "<int name='status'>0</int>" & _
      "<int name='QTime'>0</int>" & _
      "<lst name='params'>" & _
        "<str name='q'>*:*</str>" & _
        "<str name='indent'>true</str>" & _
        "<str name='wt'>xml</str>" & _
      "</lst>" & _
    "</lst>" & _
    "<result name='response' numFound='5429' start='0'>" & _
      "<doc>" & _
        "<int name='idProductCategory'>2</int>" & _
        "<str name='categoryname'>Live Animals</str>" & _
        "<int name='categoryLevel'>2</int>" & _
        "<str name='bestOfferEnabled'>false</str>" & _
        "<str name='leafCategory'>true</str>" & _
        "<int name='parentCategoryId'>1</int>" & _
        "<long name='_version_'>1535190804282212352</long>" & _
      "</doc>" & _
    "</result>" & _
    "</response>"

Sub test()
    Dim xmlDocument As MSXML2.DOMDocument60
    Set xmlDocument = New DOMDocument60

    If Not xmlDocument.LoadXML(XML) Then
        Err.Raise xmlDocument.parseError.ErrorCode, , xmlDocument.parseError.reason
    End If

    Dim nodeIdProductCategory As IXMLDOMNode
    Set nodeIdProductCategory = xmlDocument.SelectSingleNode("/response/result/doc/int[@name='idProductCategory']")
    If Not nodeIdProductCategory Is Nothing Then
        MsgBox nodeIdProductCategory.text
    Else
        MsgBox "Node witd name 'idProductCategory' was not found."
    End If
End Sub

#1