Get Google Maps XML data, parse it and input to Excel cells

mrwad

New Member
Joined
Oct 16, 2018
Messages
47
With help from Stackoverflow I managed to get a working solution for getting Google Maps XML data, parsing it and inputting to Excel cells. However my next intention get it working for several requests when there are 5 different locations to be analyzed and data from each XML should be inputted to different cells. I am able to do it by 5 different macros and then use like:


Code:
    Sub Master()
    Call macro1
    Call macro2
    Call macro3
    Call macro4
    Call macro5
    End Sub

I was thinking maybe I can make code faster by making just one macro and including all in there. Now I stuck with it. Maybe by including just two or three destination variants somebody can give me a hint how to proceed?


I have data on Worksheet "Other Data" (you can see first one working after running my current macro, API key is not fully displayed for reason):


5x1Nv.png



Then I have tried to make them all work, but got stuck. I use `DOMDocument30` because I would like this code to work in Excel 2013 as well. Here is my current macro:


Code:
    Sub GoogleMapsAPIDurDist()
        Dim xmlhttp As Object
        Dim xmlhttp_1 As Object
        Dim xmlhttp_2 As Object
        Dim xmlhttp_3 As Object
        Dim xmlhttp_4 As Object
        Dim myurl As String
        Dim myurl_1 As String
        Dim myurl_2 As String
        Dim myurl_3 As String
        Dim myurl_4 As String
        Dim xmlDoc As DOMDocument30
        Dim xmlNode As IXMLDOMNode
        Dim sTemp As String
        Dim RE As Object, MC As Object
        Dim rDest As Range
        Dim APIkey As Range
        Dim TravelMode As Range
    
        Set xmlDoc = New DOMDocument30
        Set xmlhttp = CreateObject("MSXML2.serverXMLHTTP")
        Set APIkey = ThisWorkbook.Worksheets("Other Data").Range("CE1")
        Set TravelMode = ThisWorkbook.Worksheets("Other Data").Range("BY3")
        
        myurl = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & ThisWorkbook.Worksheets("Other Data").Range("BY1").Value _
        & "&destinations=" & ThisWorkbook.Worksheets("Other Data").Range("BY2").Value & "&mode=" & TravelMode & "&key=" & APIkey
        
        myurl_1 = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & ThisWorkbook.Worksheets("Other Data").Range("BY5").Value _
        & "&destinations=" & ThisWorkbook.Worksheets("Other Data").Range("BY6").Value & "&mode=" & TravelMode & "&key=" & APIkey
        
        myurl_2 = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & ThisWorkbook.Worksheets("Other Data").Range("BY9").Value _
        & "&destinations=" & ThisWorkbook.Worksheets("Other Data").Range("BY10").Value & "&mode=" & TravelMode & "&key=" & APIkey
        
        myurl_3 = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & ThisWorkbook.Worksheets("Other Data").Range("BY13").Value _
        & "&destinations=" & ThisWorkbook.Worksheets("Other Data").Range("BY14").Value & "&mode=" & TravelMode & "&key=" & APIkey
        
        myurl_4 = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & ThisWorkbook.Worksheets("Other Data").Range("BY17").Value _
        & "&destinations=" & ThisWorkbook.Worksheets("Other Data").Range("BY18").Value & "&mode=" & TravelMode & "&key=" & APIkey
        
        xmlhttp.Open "GET", myurl, False
        
        'xmlhttp.Open "GET", myurl_1, False
        
        'xmlhttp.Open "GET", myurl_2, False
        
        'xmlhttp.Open "GET", myurl_3, False
        
        'xmlhttp.Open "GET", myurl_4, False
        xmlhttp.send
    
        'hard coded here.  Change to suit
        Set rDest = ThisWorkbook.Worksheets("Other Data").Range("CA2")
        
        xmlDoc.LoadXML xmlhttp.responseText
        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(0, 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, 1) = MC(0)
            End If
        End With
    
    End Sub

Posted also here: https://stackoverflow.com/questions/56810220/
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,753
The Distance Matrix API allows you to specify multiple origins and destinations, so you can send 1 request and it returns all the results. Also, you don't need to use both DOMDocument and XMLhttp.

Try incorporating something like this into your code. origins and destinations are 1-dimensional arrays containing your locations (even if there is only 1 destination).

Code:
    Dim URL As String
    Dim originsParam As String
    Dim destinationsParam As String
    
    originsParam = Join(origins, "|")
    destinationsParam = Join(destinations, "|")
    URL = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & Escape(originsParam) & "&destinations=" & Escape(destinationsParam) & "&mode=" & TravelMode & "&key=" & APIkey
    
    With xmlDoc
        .async = False
        .Load URL
        Debug.Print .XML
    End With
You also need this function to URL-encode the parameters:
Code:
Public Function Escape(ByVal param As String) As String

    Dim i As Integer, BadChars As String

    BadChars = "%<>=&!@#$^()+{[}]|\;:'"",/?"
    For i = 1 To Len(BadChars)
        param = Replace(param, Mid(BadChars, i, 1), "%" & Hex(Asc(Mid(BadChars, i, 1))))
    Next
    param = Replace(param, " ", "+")
    Escape = param

End Function
 

mrwad

New Member
Joined
Oct 16, 2018
Messages
47
Thanks for this! Looks very interesting and nice alternative to what I was trying to achieve! Can you please describe in more detail how to set origins and destinations? Maybe some example?

Code:
Sub GetMyValuesGoogleAPI()
    Dim URL As String
    Dim originsParam As String
    Dim destinationsParam As String
    Dim APIkey As Range, TravelMode As Range
    
    Set APIkey = ThisWorkbook.Worksheets("Other Data").Range("CE1")
    Set TravelMode = ThisWorkbook.Worksheets("Other Data").Range("BY3")
    
    originsParam = Join(origins, "|")
    destinationsParam = Join(destinations, "|")
    URL = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & Escape(originsParam) & "&destinations=" & Escape(destinationsParam) & "&mode=" & TravelMode & "&key=" & APIkey
    
    With xmlDoc
        .async = False
        .Load URL
        Debug.Print .XML
    End With
End Sub


Public Function Escape(ByVal param As String) As String


    Dim i As Integer, BadChars As String


    BadChars = "%<>=&!@#$^()+{[}]|\;:'"",/?"
    For i = 1 To Len(BadChars)
        param = Replace(param, Mid(BadChars, i, 1), "%" & Hex(Asc(Mid(BadChars, i, 1))))
    Next
    param = Replace(param, " ", "+")
    Escape = param


End Function
 

mrwad

New Member
Joined
Oct 16, 2018
Messages
47
Now this is one huge XML to get data out. I need to get duration like `1 hour 30 mins` and distance like `103 km` out for each one. How is this possible?


Here is my VBA:


Code:
    Sub GetMyValuesGoogleAPI()
        Dim URL As String
        Dim originsParam As String
        Dim destinationsParam As String
        Dim APIkey As Range, TravelMode As Range
        
        Dim xmlDoc As DOMDocument30
        
        Dim origins(0 To 4) As String
        Dim destinations(0 To 4) As String
        
        Dim n As Integer
    
        n = FreeFile()
        Open Environ$("USERPROFILE") & "\Desktop\" & "test.txt" For Output As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=n]#n[/URL] 
        
        origins(0) = "London, UK"
        origins(1) = "Manchester, UK"
        origins(2) = "Liverpool, UK"
        origins(3) = "Bristol, UK"
        origins(4) = "Bath, UK"
        
        destinations(0) = "Cambridge, UK"
        destinations(1) = "Leeds, UK"
        destinations(2) = "Cambridge, UK"
        destinations(3) = "Norwich, UK"
        destinations(4) = "Brighton, UK"
        
        Set APIkey = ThisWorkbook.Worksheets("Other Data").Range("CE1")
        Set TravelMode = ThisWorkbook.Worksheets("Other Data").Range("BY3")
        Set xmlDoc = New DOMDocument30
        
        originsParam = Join(origins, "|")
        destinationsParam = Join(destinations, "|")
        URL = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & Escape(originsParam) & "&destinations=" _
        & Escape(destinationsParam) & "&mode=" & TravelMode & "&key=" & APIkey
        
        With xmlDoc
            .async = False
            .Load URL
            Debug.Print .XML
            Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=n]#n[/URL] , .XML
        End With
        
    End Sub
Function:


Code:
    Public Function Escape(ByVal param As String) As String
    
        Dim i As Integer, BadChars As String
    
        BadChars = "%<>=&!@#$^()+{[}]|\;:'"",/?"
        For i = 1 To Len(BadChars)
            param = Replace(param, Mid(BadChars, i, 1), "%" & Hex(Asc(Mid(BadChars, i, 1))))
        Next
        param = Replace(param, " ", "+")
        Escape = param
    
    End Function
Here is XML output:


Code:
    <?xml version="1.0"?>
    <DistanceMatrixResponse>
    	<status>OK</status>
    	<origin_address>London, UK</origin_address>
    	<origin_address>Manchester, UK</origin_address>
    	<origin_address>Liverpool, UK</origin_address>
    	<origin_address>Bristol, UK</origin_address>
    	<origin_address>Bath, UK</origin_address>
    	<destination_address>Cambridge, UK</destination_address>
    	<destination_address>Leeds, UK</destination_address>
    	<destination_address>Cambridge, UK</destination_address>
    	<destination_address>Norwich, UK</destination_address>
    	<destination_address>Brighton, UK</destination_address>
    	<row>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>5420</value>
    				<text>1 hour 30 mins</text>
    			</duration>
    			<distance>
    				<value>103024</value>
    				<text>103 km</text>
    			</distance>
    		</element>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>13268</value>
    				<text>3 hours 41 mins</text>
    			</duration>
    			<distance>
    				<value>313516</value>
    				<text>314 km</text>
    			</distance>
    		</element>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>5420</value>
    				<text>1 hour 30 mins</text>
    			</duration>
    			<distance>
    				<value>103024</value>
    				<text>103 km</text>
    			</distance>
    		</element>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>8674</value>
    				<text>2 hours 25 mins</text>
    			</duration>
    			<distance>
    				<value>189805</value>
    				<text>190 km</text>
    			</distance>
    		</element>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>6696</value>
    				<text>1 hour 52 mins</text>
    			</duration>
    			<distance>
    				<value>103629</value>
    				<text>104 km</text>
    			</distance>
    		</element>
    	</row>
    	<row>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>12617</value>
    				<text>3 hours 30 mins</text>
    			</duration>
    			<distance>
    				<value>301588</value>
    				<text>302 km</text>
    			</distance>
    		</element>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>3723</value>
    				<text>1 hour 2 mins</text>
    			</duration>
    			<distance>
    				<value>71765</value>
    				<text>71.8 km</text>
    			</distance>
    		</element>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>12617</value>
    				<text>3 hours 30 mins</text>
    			</duration>
    			<distance>
    				<value>301588</value>
    				<text>302 km</text>
    			</distance>
    		</element>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>15640</value>
    				<text>4 hours 21 mins</text>
    			</duration>
    			<distance>
    				<value>336098</value>
    				<text>336 km</text>
    			</distance>
    		</element>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>16712</value>
    				<text>4 hours 39 mins</text>
    			</duration>
    			<distance>
    				<value>417143</value>
    				<text>417 km</text>
    			</distance>
    		</element>
    	</row>
    	<row>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>13457</value>
    				<text>3 hours 44 mins</text>
    			</duration>
    			<distance>
    				<value>312942</value>
    				<text>313 km</text>
    			</distance>
    		</element>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>5458</value>
    				<text>1 hour 31 mins</text>
    			</duration>
    			<distance>
    				<value>117472</value>
    				<text>117 km</text>
    			</distance>
    		</element>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>13457</value>
    				<text>3 hours 44 mins</text>
    			</duration>
    			<distance>
    				<value>312942</value>
    				<text>313 km</text>
    			</distance>
    		</element>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>17245</value>
    				<text>4 hours 47 mins</text>
    			</duration>
    			<distance>
    				<value>409544</value>
    				<text>410 km</text>
    			</distance>
    		</element>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>17253</value>
    				<text>4 hours 48 mins</text>
    			</duration>
    			<distance>
    				<value>437125</value>
    				<text>437 km</text>
    			</distance>
    		</element>
    	</row>
    	<row>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>11371</value>
    				<text>3 hours 10 mins</text>
    			</duration>
    			<distance>
    				<value>269123</value>
    				<text>269 km</text>
    			</distance>
    		</element>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>12344</value>
    				<text>3 hours 26 mins</text>
    			</duration>
    			<distance>
    				<value>333320</value>
    				<text>333 km</text>
    			</distance>
    		</element>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>11344</value>
    				<text>3 hours 9 mins</text>
    			</duration>
    			<distance>
    				<value>272045</value>
    				<text>272 km</text>
    			</distance>
    		</element>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>14866</value>
    				<text>4 hours 8 mins</text>
    			</duration>
    			<distance>
    				<value>386263</value>
    				<text>386 km</text>
    			</distance>
    		</element>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>10533</value>
    				<text>2 hours 56 mins</text>
    			</duration>
    			<distance>
    				<value>254730</value>
    				<text>255 km</text>
    			</distance>
    		</element>
    	</row>
    	<row>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>11688</value>
    				<text>3 hours 15 mins</text>
    			</duration>
    			<distance>
    				<value>264172</value>
    				<text>264 km</text>
    			</distance>
    		</element>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>13467</value>
    				<text>3 hours 44 mins</text>
    			</duration>
    			<distance>
    				<value>352919</value>
    				<text>353 km</text>
    			</distance>
    		</element>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>11662</value>
    				<text>3 hours 14 mins</text>
    			</duration>
    			<distance>
    				<value>267094</value>
    				<text>267 km</text>
    			</distance>
    		</element>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>15183</value>
    				<text>4 hours 13 mins</text>
    			</duration>
    			<distance>
    				<value>381312</value>
    				<text>381 km</text>
    			</distance>
    		</element>
    		<element>
    			<status>OK</status>
    			<duration>
    				<value>10850</value>
    				<text>3 hours 1 min</text>
    			</duration>
    			<distance>
    				<value>249779</value>
    				<text>250 km</text>
    			</distance>
    		</element>
    	</row>
    </DistanceMatrixResponse>
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,753
Try this macro:
Code:
Sub GetMyValuesGoogleAPI()

    Dim URL As String
    Dim originsParam As String
    Dim destinationsParam As String
    Dim APIkey As Range, TravelMode As Range
    Dim origins(0 To 4) As String
    Dim destinations(0 To 3) As String
    Dim n As Integer
    Dim statusNode As IXMLDOMNode
    Dim rowNodes As IXMLDOMNodeList
    Dim elementNodes As IXMLDOMNodeList
    Dim element As IXMLDOMNode
    Dim r As Long, c As Long
    
    origins(0) = "London, UK"
    origins(1) = "Manchester, UK"
    origins(2) = "Liverpool, UK"
    origins(3) = "Bristol, UK"
    origins(4) = "Bath, UK"
    
    destinations(0) = "Leeds, UK"
    destinations(1) = "Cambridge, UK"
    destinations(2) = "Norwich, UK"
    destinations(3) = "Brighton, UK"
    
    Dim xmlDoc As DOMDocument30
    Set xmlDoc = New DOMDocument30
    Set APIkey = ThisWorkbook.Worksheets("Other Data").Range("CE1")
    Set TravelMode = ThisWorkbook.Worksheets("Other Data").Range("BY3")
    
    originsParam = Join(origins, "|")
    destinationsParam = Join(destinations, "|")
    URL = "https://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & Escape(originsParam) & "&destinations=" _
          & Escape(destinationsParam) & "&mode=" & TravelMode & "&key=" & APIkey
    
    With xmlDoc
        .async = False
        .Load URL
'        Debug.Print .XML
'        n = FreeFile()
'        Open Environ$("USERPROFILE") & "\Desktop\" & "test.txt" For Output As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=n]#n[/URL] 
'        Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=n]#n[/URL] , .XML
'        Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=n]#n[/URL] 
        Set statusNode = .SelectSingleNode("/DistanceMatrixResponse/status")
        Set rowNodes = .selectNodes("/DistanceMatrixResponse/row")
    End With
    
    If statusNode.Text = "OK" Then
        For r = 0 To rowNodes.Length - 1
            Set elementNodes = rowNodes(r).selectNodes("element")
            For c = 0 To elementNodes.Length - 1
                Debug.Print origins(r) & " to " & destinations(c); " - ";
                Set element = elementNodes(c)
                If element.SelectSingleNode("status").nodeTypedValue = "OK" Then
                    'Debug.Print element.SelectSingleNode("distance/value").nodeTypedValue
                    'Debug.Print element.SelectSingleNode("duration/value").nodeTypedValue
                    Debug.Print element.SelectSingleNode("distance/text").nodeTypedValue; ", ";
                    Debug.Print element.SelectSingleNode("duration/text").nodeTypedValue
                Else
                    Debug.Print element.SelectSingleNode("status").nodeTypedValue
                End If
            Next
        Next
    Else
        Debug.Print statusNode.Text
    End If
     
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,129,902
Messages
5,638,896
Members
417,058
Latest member
BRYCEPIETROWIAK

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top