KM Entfernung aus Google Maps auslesen

[elvodia]

Gesundes neues Jahr wünsche ich allen.

Über folgenden Code lasse ich eien Routenberechnung via Google maps machen.

Code [Auswählen] Erweitern

VAR_von_anschrift = Me.von.Column(2)
VAR_von_plz = Me.von.Column(3)
VAR_von_ort = Me.von.Column(4)
VAR_nach_anschrift = Me.nach.Column(2)
VAR_nach_plz = Me.nach.Column(3)
VAR_nach_ort = Me.nach.Column(4)


URL = "http://maps.google.de/maps?f=q&source=s_q&view=text&q=D%2C+" & VAR_von_plz & "+" & VAR_von_ort & "%2C+" & VAR_von_anschrift & " nach D%2C+" & VAR_nach_plz & "+" & VAR_nach_ort & "%2C+" & VAR_nach_anschrift & ""
CreateObject("Shell.Application").ShellExecute URL

Im Quelltext den Maps dann ausspuckt gibt es ein Div was die angaben enthält.

Bsp.:

Code [Auswählen] Erweitern

<div class="dir-altroute-inner">  <div class="altroute-rcol altroute-info"> <span>4,9 km</span>, <span>8 Minuten</span>   </div> <div>Karower Chaussee</div>

Besteht die Möglichkeit die KM Angabe auszulesen?

[MzKlMu]

Hallo,
ist die Anzahl der Zeichen vor der ersten Zahl (hier die 4) immer gleich?

[elvodia]

Meinst du bis zum Kompletten Anfang also 1 Zeichen des Quellcodes?

[MzKlMu]

Hallo,
nein, in dem Text den Maps zurückliefert.

[elvodia]

Ich weis net wie du das meinst. Ich öffne per Button den I-Explorer und der berechnet mir die Strecke. Dann habe ich im Explorer mir den Quelltext anzeigen lassen dun den Part gesucht der mit der Kilometer Zahl übereinstimmt wie oben Gepostet. Und die Kilometer möchte ich in eine Access Variable übergeben.

[DF6GL]

Hallo,

wenn Du die Textpassage mit der Kilometeranzahl findest (gefunden hast), dann such  halt darin die Position des  (fetten) Text-Teils:


<span>4,9 km</span>,

und darauf aufbauend das vorangangene <span> -Tag. Abschliessend extrahierst Du die Angabe (Zeichen)  zwischen <span> und </span>

[elvodia]

Und genau hier haperst. Ich habe keine Ahnung wie ich eine Passage aus dem Quelltext in Access importiere und dann zerpflücke.

[DF6GL]

Hallo,

dafür gibt es die Funktionen

Instr
Instrrev
Mid
Left
Right
Replace
etc...

siehe VBA-Hilfe

[elvodia]

und wie kann ich den Quellcode nach access importieren?

[daolix]

und wie kann ich den Quellcode nach access importieren?

mit dem IE-Object oder
dem WinHttpRequest oder ganz billig mit
URLDownloadToFile und anschließendem einlesen der Quellcodedatei.


Hier mal Ansatz der Billig-Variante

Code (Ist aber ungetestet < Luftcode  und nicht vollständig >) [Auswählen] Erweitern

Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" ( _
        ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Const S_OK = 0

...


VAR_von_anschrift = Me.von.Column(2)
VAR_von_plz = Me.von.Column(3)
VAR_von_ort = Me.von.Column(4)
VAR_nach_anschrift = Me.nach.Column(2)
VAR_nach_plz = Me.nach.Column(3)
VAR_nach_ort = Me.nach.Column(4)

Var_FileName = "c:\dein_Path\mapsTemp.txt"

URL = "http://maps.google.de/maps?f=q&source=s_q&view=text&q=D%2C+" & VAR_von_plz & "+" & VAR_von_ort & "%2C+" & VAR_von_anschrift & " nach D%2C+" & VAR_nach_plz & "+" & VAR_nach_ort & "%2C+" & VAR_nach_anschrift & ""


IF URLDownloadToFile( BYVAL 0, URL, Var_FileName, 0, 0 ) = S_OK THEN   
   'DL erfolgreich
    ff = Freefile
    open  Var_FileName for Binary as #ff
    sOut = String$(LOF(#ff), 0)
    get #ff,, sOut
    Close #ff

    'Ab hier kannst du mit Regexpr oder den genannten Funktionen von DF6GL arbeiten
    ....



[elvodia]

Kann mir bitte mal jemand nen einfachen URLDownloadToFile Code schreiben wo die URL aus der Variable URL gezogen wird und die Datei und c:\test.txt gespeichert wird.

Ich komm damit nicht klar

[daolix]

neues Modul mit folgendem Code:

Code [Auswählen] Erweitern

Option Compare Database
Option Explicit

'// ----------------------------------------------------------------------------------------------------------------
'//
'// ----------------------------------------------------------------------------------------------------------------
Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
        ( _
            ByVal pCaller As Long, _
            ByVal szURL As String, _
            ByVal szFileName As String, _
            ByVal dwReserved As Long, _
            ByVal lpfnCB As Long _
        ) As Long

'// ----------------------------------------------------------------------------------------------------------------
'//
'// ----------------------------------------------------------------------------------------------------------------
Const S_OK = 0

Function GoogleEntfernung _
            ( _
                VAR_von_anschrift As String, _
                VAR_von_plz As String, _
                VAR_von_ort As String, _
                VAR_nach_anschrift As String, _
                VAR_nach_plz As String, _
                VAR_nach_ort As String _
            ) As String
           
           
    '// ** Variablen & Konstanten **
    Dim URL As String, sFile As String, sTxt As String
    Dim ff As Integer
    Dim lA As Long
    Const FA As String = "<div class=""dir-altroute-inner"">  <div class=""altroute-rcol altroute-info""> <span>"
    Const FE As String = "</span>"
   
    '// ** Baue URL **
    URL = "http://maps.google.de/maps?f=q&source=s_q&view=text&q=D%2C+" & _
            VAR_von_plz & "+" & _
            VAR_von_ort & "+" & _
            VAR_von_anschrift & " nach D%2C+" & _
            VAR_nach_plz & "+" & _
            VAR_nach_ort & "+" & _
            VAR_nach_anschrift
                 
    '// ** Lokale Datei **
    sFile = "c:\test.txt"
   
    '// ** Lösche vorhandene Datei **
    If Len(Dir$(sFile)) > 0 Then Kill sFile
   
    '// ** Download **
    If URLDownloadToFile(ByVal 0, URL, sFile, 0, 0) = S_OK Then
        '// ** erfolgreich **
        '// ** lese lokale Datei **
        ff = FreeFile
        Open sFile For Binary As #ff
        sTxt = String$(LOF(ff), 0)
        Get #ff, , sTxt
        Close ff
       
        '// ** Zerlege String, suche die km's **
        lA = InStr(1, sTxt, FA)
        If lA > 0 Then
            lA = lA + Len(FA)
            GoogleEntfernung = Mid$(sTxt, lA, InStr(lA, sTxt, FE) - lA)
        Else
            '// ** wurde was falsches geladen **
            MsgBox "Wat'n Mist"
        End If
    Else
        MsgBox "Mist"
    End If
End Function



der Aufruf erfolgt dann aus einem Formular oder anderem Modul in etwa so:

Code [Auswählen] Erweitern


    MsgBox GoogleEntfernung( _
                                "Sonnenallee", _
                                "12059", _
                                "Berlin", _
                                "Großbeerenstr", _
                                "10963", _
                                "Berlin" _
                            )


[elvodia]

Super das funktioniert Einwand frei. Nur habe ich leider das Problem das mein Feld wo ich die km eintragen möchte ein double ist und die Ausgabe km hinter der Zahl noch weg müsste.

[daolix]

ändere die Zeile

Code [Auswählen] Erweitern

Const FE As String = "</span>"
in

Code [Auswählen] Erweitern

Const FE As String = "km</span>"

und den Aufruf wie ählich:

Code [Auswählen] Erweitern


Dim d as double
d = GoogleEntfernung( ..........


[elvodia]

Klappt super. Vielen vielen dank