Google Directions mit Excel VBA
04.06.2019 03:35:15
Fabs
Ich muss die Wegstrecke von einigen Routen mit mehrere Koordinaten bestimmen. Dafür möchte ich mit Google Direction Api eine Webabfrage erstellen.
Soweit klappt das alles. Mein Problem ist jetzt die Daten aus der Abfrage herauszuziehen und zurückzugeben.
Für einfache Verbindungen zwischen 2 punkten habe ich das bereits geschafft. Hierzu habe ich _ folgende Vorlage genutzt (meinen API schlüssel habe ich wieder gelöscht).
'Calculate Google Maps distance between two addresses
Public Function GetDistance(start As String, dest As String)
Dim firstVal As String, secondVal As String, lastVal As String
firstVal = "https://maps.googleapis.com/maps/api/distancematrix/json?origins="
secondVal = "&destinations="
lastVal = "&mode=car&language=pl&sensor=false&key=XXXXXXXXXX"
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
Url = firstVal & Replace(start, " ", "+") & secondVal & Replace(dest, " ", "+") & lastVal
objHTTP.Open "GET", Url, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.send ("")
If InStr(objHTTP.responseText, """distance"" : {") = 0 Then GoTo ErrorHandl
Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = """value"".*?([0-9]+)": regex. _
Global = False
Set matches = regex.Execute(objHTTP.responseText)
tmpVal = Replace(matches(0).SubMatches(0), ".", Application.International(xlListSeparator))
GetDistance = CDbl(tmpVal)
Exit Function
ErrorHandl:
GetDistance = -1
End Function
Dafür muss ich auf Google Directions zurückgreifen.
https://maps.googleapis.com/maps/api/directions/json?origin=38.070477,23.784800&destination=38. _
070477,23.784800&waypoints=optimize:true|37.9776,23.7082|38.0545,23.8389|38.0838,23.5318&mode=car&language=pl&key=API_KEY
Mit der Verwendung von Google Directions und der Verwendung von Wegpunkten (zusätzlich zu Start- und Zielangaben) ändert sich die Ausgabe der Daten von
https://www.dropbox.com/s/h1nha94h1alcrub/JSON_Einfach.PNG?dl=0
zu einer deutlich komplexeren:
https://www.dropbox.com/s/bmzmasndv15c0pd/JSON.PNG?dl=0
Meine Frage ist jetzt wie ich es schaffe, mit der Funktion trotzdem alle Daten der Entfernung abzugreifen und zurückzugeben. Das muss auch nicht einzeln sein, da ich nur an der Summe der Werte interessiert bin.
Da ich mich leider kaum mit VBA und noch weniger mit XMLHTTP60 oder MSXML6 auskenne, hoffe ich hier auf Hilfe. Schon mal danke fürs Lesen und Mitdenken.
(Eine einzelne Berechnung der Entfernungen ist nicht möglich, da ich auf das Optimieren der Wegpunkte durch Google angewiesen bin. Google gibt zwar auch die Reihenfolge der Wegpunkte an, doch diese müssten ebenfalls ausgelesen werden...)
Neben der von mir zuvor genutzten Funktion habe ich auch eine alternative gefunden, die ich allerdings leider auch nicht zum laufen bekommen habe.
Sub getDistances()
Dim xhrRequest As XMLHTTP60
Dim domDoc As DOMDocument60
Dim ixnlDistanceNodes As IXMLDOMNodeList
Dim ixnNode As IXMLDOMNode
Dim lOutputRow As Long
' Read the data from the website
Set xhrRequest = New XMLHTTP60
xhrRequest.Open "GET", "https://maps.googleapis.com/maps/api/directions/xml?origin=38.070477,23. _
_
784800&destination=38.070477,23.784800&waypoints=optimize:true|37.9776,23.7082|38.0545,23.8389| _
38.0838,23.5318&mode=car&language=pl&key=xxxxxxxxxxxxxx", False
xhrRequest.send
' Copy the results into a format we can manipulate with XPath
Set domDoc = New DOMDocument60
domDoc.LoadXML xhrRequest.responseText
' The important bit: select every node called "value" which is the child of a node called " _
distance" which is
' in turn the child of a node called "step"
Set ixnlDistanceNodes = domDoc.SelectNodes("//step/distance/value")
' Basic stuff to output the distances
lOutputRow = 1
With Worksheets("Sheet1")
.UsedRange.ClearContents
For Each ixnNode In ixnlDistanceNodes
.Cells(lOutputRow, 1).Value = ixnNode.Text
lOutputRow = lOutputRow + 1
Next ixnNode
End With
Set ixnNode = Nothing
Set ixnlDistanceNodes = Nothing
Set domDoc = Nothing
Set xhrRequest = Nothing
End Sub
Als dritte Alternative habe ich auch noch gesehen, dass wenn im Link der Webabfrage JSON mit XML getauscht wird, dann entsteht ein Buchstabensalat, in dem ich allerdings die von mir benötigten Entfernungen mit einer Suche sicher identifizieren kann. Leider fehlt mir auch hier das nötige Verständnis, wie ich diesen Vorgang mit VBA automatisieren könnte.
https://www.dropbox.com/s/mu82u4p3ec4819c/Alternative3.PNG?dl=0
Alle benötigten Entfernungen stehen hierbei immer vor " km 3"
Vielen Dank für eure Hilfe