Neuigkeiten:

Wenn ihr euch für eine gute Antwort bedanken möchtet, im entsprechenden Posting einfach den Knopf "sag Danke" drücken!

Mobiles Hauptmenü

Auslesen aus Internetseite (Entfernungen)

Begonnen von Berlin-Lackierung.de, Mai 26, 2017, 14:08:01

⏪ vorheriges - nächstes ⏩

Berlin-Lackierung.de

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

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.
,,Bei einem Fußballspiel verkompliziert sich alles durch die Anwesenheit der gegnerischen Mannschaft." - Jean Paul Sartre

steffen0815

#1
Hallo,
dafür sollten sich unzählige Beispiele im Netz finden lassen.
VBA - Entfernungsberechnung mit Google Maps
Gruß Steffen

Berlin-Lackierung.de

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.
,,Bei einem Fußballspiel verkompliziert sich alles durch die Anwesenheit der gegnerischen Mannschaft." - Jean Paul Sartre

steffen0815

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
Gruß Steffen

Berlin-Lackierung.de

SUPER - funktioniert - PERFEKT - Danke :)
,,Bei einem Fußballspiel verkompliziert sich alles durch die Anwesenheit der gegnerischen Mannschaft." - Jean Paul Sartre

datekk

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

Access 2016 mit SQL Server Backend. Bereits umgesetzt: Access mit MS SQL Backend,  ADODB Formularbindung, Streamen von Dateien zum SQL Server und zurück (Filestream), Drag&Drop Dateiupload zum Server, CTI / TAPI Integrierung in Access Anwendung - Nutzung auch über Remote Desktop, selbst aktualisierendes Access Frontend auf entfernten Rechnern (Upgrade). Berichte / Kreuztabellen mit SQL Server Backend, Mail Tagging, Outlook Steuerung über Access und umgekehrt // Grundwissen in .Net Core & Blazor Apps