Разбор определенных значений из Google Maps XML в ячейки Excel

Question

У меня есть ссылка "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=...", к которой я обращаюсь, чтобы получить данные XML-файла.

Файл XML:

<DistanceMatrixResponse>
<status>OK</status>
<origin_address>London, UK</origin_address>
<destination_address>Manchester, UK</destination_address>
<row>
<element>
<status>OK</status>
<duration>
<value>14735</value>
<text>4 hours 6 mins</text>
</duration>
<distance>
<value>335534</value>
<text>336 km</text>
</distance>
</element>
</row>
</DistanceMatrixResponse>

Структура файла XML всегда одинакова.Мне нужно получить <text>4 hours 6 mins</text> и <text>336 km</text> в виде 4,6 для ячейки A1 и 336 для ячейки A2, скажем «База данных контактов».Также проблема в том, что <text>4 hours 6 mins</text> иногда может быть <text>1 hour 3 min</text>.Я могу сделать это с формулой, но возможно ли это с VBA?

Мне удалось заставить его работать так, чтобы все данные XML-файла находились в ячейке A1.Однако не в состоянии отделить то, что мне нужно, и вставить в две разные ячейки.

Sub GoogleAPI1()
Dim xmlhttp As Object
Set xmlhttp = CreateObject("MSXML2.serverXMLHTTP")
Dim myurl As String

myurl = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & ThisWorkbook.Worksheets("Contact database").Range("R86").Value _
& "&destinations=" & ThisWorkbook.Worksheets("Contact database").Range("R87").Value & "&mode=" & ThisWorkbook.Worksheets("Contact database").Range("R88").Value _
& "&key=" & ThisWorkbook.Worksheets("Contact database").Range("R82").Value

xmlhttp.Open "GET", myurl, False
xmlhttp.send
ThisWorkbook.Worksheets("Contact database").Range("R92") = xmlhttp.responseText
End Sub

Answer 1

Вот один из способов использования VBA для получения описанных вами результатов.

Я извлек информацию об узле, а затем обработал ее с помощью регулярных выражений, чтобы получить ее в формате, который вы описали.

Возможно, это можно сделать более эффективно и с большей или иной проверкой ошибок, но это может помочь вам начать работу.

Option Explicit
Sub getDurDist()
    Dim xmlDoc As DOMDocument60
    Dim xmlNode As IXMLDOMNode
    Dim sTemp As String
    Dim RE As Object, MC As Object
    Dim rDest As Range

Set xmlDoc = New DOMDocument60

'hard coded here.  Change to suit
Set rDest = Range("B1:C1")
rDest.Clear

xmlDoc.LoadXML Range("a1")
Set xmlNode = xmlDoc.SelectSingleNode("//duration/text")


sTemp = xmlNode.Text

Set RE = CreateObject("vbscript.regexp")
With RE
    .Global = True
    .Pattern = "\d+"
    If .test(sTemp) = True Then
        Set MC = .Execute(sTemp)
        rDest(1, 1) = MC(0) & "," & MC(1)
    End If
End With


Set xmlNode = xmlDoc.SelectSingleNode("//distance/text")
sTemp = xmlNode.Text
With RE
    If .test(sTemp) = True Then
        Set MC = .Execute(sTemp)
        rDest(1, 2) = MC(0)
    End If
End With

End Sub