VBA wählen XML-Element val nach Attributname

Question

Ich habe SO (und den Rest des Internets) für die Antwort gesucht, aber ich kann nicht scheinen, eine Lösung für die Auswahl eines XML-Knotens basierend auf einem Attribut zu finden.
Das ist mein XML darunter für productcategoryid von einem REST-Service XML Platzierung

<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> 

ich brauche, ist das Element der idProductCategory, dh 2, durch VBA-Code zu bekommen, aber ich kann es nicht von unten Code machen .

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 helfen Sie mir bitte, ich auf diese bin zu kämpfen Ich brauche Element Wert von Attributnamen aus diesem über XML zu erhalten und es in einer bestimmten Zelle in Excel zu platzieren.

Answer 1

Dieser Code funktioniert, es ist weniger elegant als die Abfrage, die Sie versucht zu verwenden, aber IMO ist es leichter zu verstehen, wie die Arbeit mit XML kann ein bisschen verwirrend sein.

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 

Die XML-Beispiel verwendet wurde, war:

<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> 

Answer 2

Mit SelectSingleNode der Code wie folgt aussehen könnte. 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