如何通过VBA将某些XML数据读入Excel

Question

I got a XML response text from Google Map Distance Matrix API that I have to read it into Excel or message out certain information from the XML response text. I will just need the Value in <Status> , <Text> in duration and <Text> in distance.

This is my VBA code:

Sub Button1_Click()
Dim x As Long, y As Long
Dim htm As Object
Dim wb As Workbook
Dim ws As Worksheet
Dim TxtRng  As Range

Dim num1 As String

Set wb = ActiveWorkbook
Set ws = wb.Sheets("Sheet1")

Set htm = CreateObject("htmlFile")
num1 = Cells(2, 2).Value

With CreateObject("msxml2.xmlhttp")
    .Open "GET", "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=sy8 2jp&destinations=" & num1 & "&mode=driving&language=en-GB&v=3&sensor=false&units=imperial", False
    .send
    htm.body.innerHTML = .responseText
    Debug.Print .responseText (don't know how to debug print certain value)

    MSGbox (.responseText)(or strip out certain value of response text)
End With

End Sub

This is my debug print response text

 <status>OK</status>
 <origin_address UK</origin_address>
 <destination_address>UK</destination_address>
 <row>
  <element>
    <status>OK</status>
      <duration>
      <value>622</value>
      <text>10 mins</text>
      </duration>
   <distance>
     <value>8552</value>
     <text>5.3 mi</text>
   </distance>
 </element>
</row>
</DistanceMatrixResponse>

Answer 1

After you add a reference to "Microsoft XML, v3.0" in VBA you can use the following;

Sub GetSingleNodes()
    Dim objXML As MSXML2.DOMDocument
    Dim strXML As String
    Set objXML = New MSXML2.DOMDocument

    Set htm = CreateObject("htmlFile")
    num1 = Cells(2, 2).Value
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=sy8 2jp&destinations=" & num1 & "&mode=driving&language=en-GB&v=3&sensor=false&units=imperial", False
        .send
        xmlresp = .responseText
    End With

    objXML.LoadXML (xmlresp)
    Dim objElem As MSXML2.IXMLDOMElement
    Status = objXML.SelectSingleNode("DistanceMatrixResponse/row/element/status").Text
    If Status = "OK" Then
        Duration = objXML.SelectSingleNode("DistanceMatrixResponse/row/element/status/duration/text").Text
        Distance = objXML.SelectSingleNode("DistanceMatrixResponse/row/element/status/distance/text").Text
    End If
End Sub