VBA - 从 XML 代码循环特定子节点

Question

我正在尝试将以下 Xml 抓取到 Excel 工作表中。但是，我只想遍历特定的子节点以显示每个索引摘要的 Name、PriceEffectiveStart、PriceEffectiveEnd、Price 和 Currency。

XML 代码

<indexPrices>
     <indexPriceSummary>
         <id>1</id>
         <uri>www.example.com</uri>
      <index>
        <id>3</id>
        <name>Same Day Index</name>
        <uri>www.example.com.xml</uri>
      </index>
      <priceEffectiveStart>2015-06-26</priceEffectiveStart>
      <priceEffectiveEnd>2015-06-26</priceEffectiveEnd>
      <price>
         <amount>2.4806</amount>
         <currency>CAD</currency>
      </price>
      <duration>1</duration>
      <quantityTraded>
        <amount>474</amount>
        <unit>GJ</unit>
        <contractUnit>Day</contractUnit>
      </quantityTraded>
      <numberOfTrades>7</numberOfTrades>
      <settlementState>Settled</settlementState>
      <lastUpdateDate>2015-06-27T02:15:01-06:00</lastUpdateDate>
    </indexPriceSummary>
    <indexPriceSummary>
        <id>1</id>
        <uri>www.example.com.xml</uri>
     <index>
      <id>1</id>
      <name>Same Day Index </name>
      <uri>www.example.com.xml</uri>
     </index>
     <priceEffectiveStart>2015-06-27</priceEffectiveStart>
     <priceEffectiveEnd>2015-06-27</priceEffectiveEnd>
     <price>
         <amount>2.516</amount>
         <currency>CAD</currency>
     </price>
     <duration>1</duration>
     <quantityTraded>
        <amount>251</amount>
        <unit>GJ</unit>
        <contractUnit>Day</contractUnit>
     </quantityTraded>
     <numberOfTrades>50</numberOfTrades>
     <settlementState>Settled</settlementState>
     <lastUpdateDate>2015-06-28T02:15:00-06:00</lastUpdateDate>
   </indexPriceSummary>
</IndexPrices>

VBA 代码

Dim xDoc As DOMDocument
Set xDoc = New DOMDocument

xDoc.LoadXML objHTTP.responseText

Dim i As Integer
Dim list As IXMLDOMNodeList
Set list = xDoc.SelectNodes("//indexPrices/indexPriceSummary")

Dim node As IXMLDOMNode
Dim childNode As IXMLDOMNode
Dim price As IXMLDOMNode

For Each node In list
    i = i + 1

    If (node.HasChildNodes) Then
        For Each childNode In node.ChildNodes
             i = i + 1
            Debug.Print childNode.BaseName & " " & childNode.Text
             Worksheets("Sheet1").Cells(i, 1) = childNode.BaseName
             Worksheets("Sheet1").Cells(i, 2) = childNode.Text
        Next childNode
    End If


  Next node

当前 VBA 显示输出中的所有节点。我希望它只显示每个索引摘要的 Name、PriceEffectiveStart、PriceEffectiveEnd、Price 和 Currency。

Answer 1

您可以在每个 indexPriceSummary 节点上使用 xpath 直接获取子元素：

Sub Tester()
    Dim xDoc As DOMDocument
    Set xDoc = New DOMDocument

    ''more code here


    xDoc.LoadXML objHTTP.responseText

    Dim i As Integer
    Dim list As IXMLDOMNodeList
    Set list = xDoc.SelectNodes("//indexPrices/indexPriceSummary")

    Dim node As IXMLDOMNode, nd As IXMLDOMNode
    Dim childNode As IXMLDOMNode
    Dim price As IXMLDOMNode

    i = 4
    For Each node In list
        i = i + 1

        With Sheet1.Rows(i)
            .Cells(1).Value = GetNodeValue(node, "index/name")
            .Cells(2).Value = GetNodeValue(node, "priceEffectiveStart")
            .Cells(3).Value = GetNodeValue(node, "priceEffectiveEnd")
            .Cells(4).Value = GetNodeValue(node, "price/amount")
            .Cells(5).Value = GetNodeValue(node, "price/currency")
        End With

    Next node

End Sub

Function GetNodeValue(node As IXMLDOMNode, xp As String)
    Dim n As IXMLDOMNode, nv
    Set n = node.SelectSingleNode(xp)
    If Not n Is Nothing Then nv = n.nodeTypedValue
    GetNodeValue = nv
End Function