VBA通​​過屬性名稱選擇XML元素val

Question

我一直在尋找SO（以及其他Internet）的答案，但似乎無法找到用於根據屬性選擇XML節點的解決方案。
這是我的XML低於這個是用於放置productcategoryid從REST服務XML

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

我需要得到idProductCategory元素，即2，通過VBA代碼，但我無法從下面的代碼使之。

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 

所以，請幫助我，我掙扎在這我需要從這個上面的XML獲得通過屬性名稱元素的值，並將其放置在Excel中的一個特定的細胞。

Answer 1

這段代碼起作用，它比你嘗試使用的查詢更不優雅，但IMO更容易理解，因爲使用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 

使用的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> 

Answer 2

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