Hab da ein kleines Problem mit dem ich mich sowas von gar nicht auskenne...
Ich möchte von der Seite Entfernungsberechnung mit Googlemaps (Beispiel):
http://maps.googleapis.com/maps/api/distancematrix/xml?origins=33397%20Lange%20Str.%202+DE&destinations=33098%20Marienstr.%2029+DE&mode=driving&language=de-DE&sensor=false (http://maps.googleapis.com/maps/api/distancematrix/xml?origins=33397%20Lange%20Str.%202+DE&destinations=33098%20Marienstr.%2029+DE&mode=driving&language=de-DE&sensor=false)
die Km (<text>28,8 km</text>) auslesen und in meiner Datenbank im Feld "Entfernung" speichern.
Kann mir da jemand helfen dies per VBA hinzubekommen? Vielleich (wäre super), wenn die Seite gar nicht erst (sichtbar) geöffnet würde.
Ach Ja, ich verwende Mozilla als Browser.
Vielen Dank.
Hallo,
dafür sollten sich unzählige Beispiele im Netz finden lassen.
VBA - Entfernungsberechnung mit Google Maps (https://www.ecosia.org/search?q=VBA+-+Entfernungsberechnung+mit+Google+Maps)
Ja, hatte ich schon "durchsucht". Leider stelle ich mich echt zu doof an - oder was auch immer mein Fehler ist :o
Derzeit habe ich nur die jeweiligen Links zu Google Maps (also Ausgangspunkt und Zielpunkt) hinbekommen - leider jedoch nicht das auslesen der Entfernung zu Speicherung.
Hallo,
Dieser (angepasste) Code scheint vielversprechend:
Public Function GetDistance(start As String, dest As String)
Dim firstVal As String, secondVal As String, lastVal As String
Dim objHTTP As Object, url As String, regex As Object, matches As Object, tmpVal As String
firstVal = "http://maps.googleapis.com/maps/api/distancematrix/json?origins="
secondVal = "&destinations="
lastVal = "&mode=car&language=pl&sensor=false"
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), ".", ",")
GetDistance = CDbl(tmpVal)
Exit Function
ErrorHandl:
GetDistance = -1
End Function
Zitat von: Direktfenster? GetDistance("berlin","Hamburg")
288834
? round(GetDistance("Lange Str. 2, 33397 Rietberg, Deutschland","Marienstraße 29, 33098 Paderborn, Deutschland")/1000 )
28
SUPER - funktioniert - PERFEKT - Danke :)
Hier mein Code dafür. Die **** gegen dein eigenen API Zugangscode tauschen. Den gibts von Google kostenlos.
Function EntfernungKm(Startort As String, StartStraße As String) ', ZielOrt As String, ZielStraße As String) ---> kann bei variablem Ziel noch in die Klammer aufgenommen werden. Die Festlegung des Ziels weiter unten kann dann entfallen.
On Error GoTo e
Const BASE_URL = "https://maps.googleapis.com/maps/api/distancematrix/xml?"
Dim strStart As String
Dim strZiel As String
Dim URL As String
Dim strSuche As String
Dim ZielOrt As String
Dim ZielStraße As String
ZielOrt = "Berlin"
ZielStraße = "Messeweg 75"
strStart = "origins=" & Startort & " " & StartStraße & " +DE&"
strZiel = "destinations=" & ZielOrt & " " & ZielStraße & "+DE&mode=driving&key=***************"
URL = BASE_URL & strStart & strZiel
With CreateObject("new:{88D96A0B-F192-11D4-A65F-0040963251E5}")
.Open "GET", URL, False
.setRequestHeader "Content-Type", "text/plain; charset=UTF-8"
.Send
Set EntfernungKm = CreateObject("new:{88D96A05-F192-11D4-A65F-0040963251E5}")
strSuche = .responseText
End With
strSuche = Replace(strSuche, vbLf, "") ' vbCrLf, vbTab, Space$(2))
Debug.Print strSuche
strSuche = Mid(strSuche, InStr(strSuche, "<distance> <value>") + 21, 10)
strSuche = Mid(strSuche, 1, InStr(strSuche, "<") - 1)
EntfernungKm = Val(strSuche) / 1000
Exit Function
e:
EntfernungKm = 0
End Function