Excel VBA - XML ​​DomDocument возвращает значения атрибутов - PullRequest
0 голосов
/ 26 ноября 2018

Я работаю со следующим ответом XML в Excel VBA.

<XXXXX docType="GetSegmentSpeed" copyright="Copyright XXXXX Inc." versionNumber="12.9" createdDate="2018-11-26T15:08:37Z" statusId="0" statusText="" responseId="06d3aad3-c3aa-40a5-9d2c-f1ac8f713729">
   <SegmentSpeedResultSet coverage="255">
      <SegmentSpeedResults timestamp="2018-11-26T15:08:36Z">
         <Segment code="213423027" type="XDS" speed="53" average="34" reference="40" score="30" c-value="63" travelTimeMinutes="0.649" speedBucket="3"/>
         <Segment code="213423023" type="XDS" speed="53" average="38" reference="41" score="30" c-value="58" travelTimeMinutes="0.603" speedBucket="3"/>
         <Segment code="213423026" type="XDS" speed="52" average="34" reference="39" score="30" c-value="71" travelTimeMinutes="0.486" speedBucket="3"/>
         <Segment code="213423050" type="XDS" speed="52" average="34" reference="39" score="30" c-value="71" travelTimeMinutes="0.48" speedBucket="3"/>
         <Segment code="213423051" type="XDS" speed="52" average="35" reference="39" score="30" c-value="78" travelTimeMinutes="0.486" speedBucket="3"/>
      </SegmentSpeedResults>
   </SegmentSpeedResultSet>
</XXXXX> 

Я хочу найти сумму travelTimeMinutes атрибутов Сегментов .

Для начала я подумал, что я попытаюсь получить значение для первого сегмента.Это мой код:

Sub SegSetTimes()

   ' Declare Private Variables
   Dim SegString As String 'Segment set to be used for calculation
   Dim hReq As New WinHttpRequest 'HttpRequest path
   Dim strResp As String 'Response String
   Dim xmlDoc As MSXML2.DOMDocument60 'DomDocument for parsing XML

   ' Import Segment Set
   SegString = Join(WorksheetFunction.Transpose(Range("A2", Range("A2").End(xlDown)).Value), "|XDS,")

   ' Call for real-time segment information
   hReq.Open "Get", "http://eu.api.XXXXX.com/Traffic/XXXXX.ashx?Action=GetSegmentSpeed" & "&token=" & AuthToken & "&Segments=" & SegString
   hReq.Send
   ' Create string from response text
   strResp = hReq.ResponseText

   ' Import response text into DomDocument for parsing within VBA
   Set xmlDoc = New MSXML2.DOMDocument60
   If Not xmlDoc.LoadXML(strResp) Then
      MsgBox "Load Error"
   End If

   Dim n As IXMLDOMNodeList
   Set n = xmlDoc.SelectNodes("//XXXXX/SegmentSpeedResultSet/SegmentSpeedResults")

   Dim TT As Single
   TT = n.Item(0).Attributes.getNamedItem("travelTimeMinutes")

End Sub

Сбой из-за следующей ошибки:

Ошибка времени выполнения '91': переменная объекта или переменная блока не установлена ​​'

При входе в Местные жители мой IXMLDOMNodeList n выглядит правильно.Я просто не могу понять, как получить нужные значения.

У кого-нибудь есть предложения?

Ответы [ 2 ]

0 голосов
/ 26 ноября 2018

В качестве альтернативы рассмотрите возможность запуска XSLT для извлечения sum() на всех узлах без зацикливания:

XSLT (сохранить как файл .xsl, специальный файл XML дляссылка на VBA)

<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
  <xsl:output indent="yes"/>
  <xsl:strip-space elements="*"/>

  <xsl:template match="/XXXXX">
    <result>
      <xsl:value-of select="format-number(sum(descendant::Segment/@travelTimeMinutes), '#.###')"/>
    </result>
  </xsl:template>

</xsl:stylesheet>

XSLT Demo

VBA

Dim xmlDoc As New MSXML2.DOMDocument60, items As Object, item As IXMLDOMElement, total As Double
' NEW REFERENCES    
Dim xslDoc As New MSXML2.DOMDocument60, newDoc As New MSXML2.DOMDocument60

' RETRIEVE WEB REQUEST   
...same code as above...

' LOAD XML AND XSL FILES 
xmlDoc.async = False
xml.LoadXML strResp

xslDoc.async = False
xslDoc.Load "C:\Path\to\XSLT\File.xsl"

' TRANSFORM XML
xmlDoc.transformNodeToObject xslDoc, newDoc

' OUTPUT RESULT (NO LOOPING)
Debug.Print newDoc.SelectSingleNode("/result").Text
' 2.704
0 голосов
/ 26 ноября 2018

Чтение из файла. Я использую XPath для получения соответствующих узлов, а затем извлекаю значение, используя getAttribute

Public Sub testing()
    Dim xmlDoc As New MSXML2.DOMDocument60, items As Object, item As IXMLDOMElement, total As Double
    Set xmlDoc = New MSXML2.DOMDocument60
    xmlDoc.Load "C:\Users\User\Desktop\Test.xml"
    Set items = xmlDoc.SelectNodes("//Segment[@travelTimeMinutes]")
    For Each item In items
        total = total + item.getAttribute("travelTimeMinutes")
    Next
    Debug.Print total
End Sub
...