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:
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):
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:
Posted also here: https://stackoverflow.com/questions/56810220/
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):
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/