Inhalt des Webbrowser Steuerelements an eine Variable übergeben und durchsuchen

[datekk]

Hi,

ich möchte in meiner DB eine Entfernungsfunktion nutzen. Hierfür soll Google Maps herhalten 

Beispiel ist folgender Link:
http://maps.googleapis.com/maps/api/distancematrix/xml?origins=Frankfurt%20am%20Main,%20Mainweg%2075+DE&destinations=D%C3%BCsseldorf,%20Rheinweg%2020+DE&mode=driving

Der Qelltext dazu sieht so aus:

<DistanceMatrixResponse>
<status>OK</status>
<origin_address>Mainkai 75, 60311 Frankfurt am Main, Deutschland</origin_address>
<destination_address>Rheinweg 20, 40489 Düsseldorf, Deutschland</destination_address>
<row>
<element>
<status>OK</status>
<duration>
<value>9083</value>
<text>2 Stunden, 31 Minuten</text>
</duration>
<distance>
<value>244692</value>
<text>245 km</text>
</distance>
</element>
</row>
</DistanceMatrixResponse>

Nun möchte ich gern die Entfernung und die Fahrzeit jeweils in einer Variablen haben. Wenn ich o.g. Link an das Webbrowser Steuerelement gebe, wie kann ich es dann auslesen und weiterverarbeiten?

Oder gibt es einen anderen Weg als das Webbrowser Steuerelement um die API auszulesen?

LG
datekk

[datekk]

Habe zwischenzeitlich mit dem Beispiel von Lachtaube "Directions" gearbeitet und bin jetzt so weit, dass ich in die Funktion GetDirection die wichtigsten Infos via XML geschrieben bekomme. Ein debug.print auf die Function sieht nun wie folgt aus:

Beispiel:
OK Mainkai 13, ***** Frankfurt, Deutschland Rheinstraße 15, ***** Düsseldorf, Deutschland OK 1608 27 Minuten 22125 22,1 km

Nun kommt bei Lachtaube zum Ausfiltern der gewünschten Ergebnisse die Eigenschaft .SelectSingleNode zum Einsatz und hier komme ich nicht weiter.

Codeschnipsel:

Code [Auswählen] Erweitern


    With GetDirection(URL)
        Me.Text2 = .selectsinglenode("//leg/distance/text").Text
    End With



Ich erhalte die Fehlermeldung: 91: Objektvariable oder With-Blockvariable nicht festgelegt. .SelectSingleNode scheint mein Access irgendwie nicht schlucken zu wollen. Was habe ich vergessen?

Please Help

[crystal]

Hallo datekk,

die Antwort habe ich schon in deinem anderen Thread angedeutet.

Das Webbrowser-Element kennt auch ein Doc-Element, in dem der Quelltext abgebildet ist.
Es gibt diverse Möglichkeiten, auf einzelne Bestandteile des Doc-Objekt zuzugreifen, z.B.
    HDoc.getElementsByTagName("h1").Item(0).innerText
    HDoc.getElementsByClassName("xyz").Item(0).innerText
    HDoc.getElementById("abc").innerHTML

Es ist etwas schwierig, dir hier explizit weiter zu helfen, denn dein abgebildeter Quelltext ist so sicher kein HTML-Quelltext.

Mein Tipp: im Browser erzeuge dir ein Beispiel und speichere den Quelltext ab (als HTML). Diese HTML-schaust du dir dann mit einem Text-Editor, z. B. notepad an (ggf. zuvor in .txt umbenennen).
Dann suchst du im Text nach den gewünschten Infos und schaust, wie sie definiert sind (Tag, Class, ID). Mit obigen Anweisungen kannst du dann im Direktfenster die Inhalte der Elemente anschauen und musst dann zusätzlichen Schrott per VBA entfernen.
Es ist nicht einfach, das zu machen, aber mit der Zeit fällt's leichter.

Ich habe dazu im Code einen Breakpoint gesetzt (nach Zuweisung von HDoc=...) und dann im Direktfenster z.B. probiert:

? HDoc.getElementsByTagName("h1").Item(0).innerText oder
? HDoc.getElementsByTagName("h1").Item(0).innerHTML

So kannst du dich an die gewünschten Werte herantasten  - immer mit parallel geöffnetem Editor-Fenster mit dem Quellcode.

Notfalls musst du HDoc mit instr absuchen.

Problem ist, das HDoc zwar versucht, eindeutige Elemente des Quelltextes Auflistungen zuzuordnen, aber nicht jeder HTML-Quellcode die Regeln strikt befolgt.

Außerdem können Auflistungen (Bsp. Tag-Element "h1") mehrere Items enthalten, wenn im Quelltext das Tag "h1" mehrfach benutzt wurde (dann hilft ...items.count oder ...items.size weiter).

Insgesamt also eine etwas schwierige Angelegenheit, einen passenden Parser bzw. Scraper zu schreiben.

Aber ich fürche, hier hilft nur "Try & Error".

Vielleicht hast du Glück und findest einen Scraper für deinen Anwendungsfall - dann aber zumeist in c++ oder c# geschrieben...

Es hilft also nichts - du musst dich in das Thema selbst vertiefen. Die Basis dafür (Verwenung von Webbrowser und Hdoc) ist gegeben. Den Rest musst du wohl selbst herauskitzeln...

Viel Erfolg dabei und

lg
crystal

[datekk]

Bestens Crystal und vielen lieben Dank. Hattest Du schon meinen Ergänzungspost gelesen bzgl. des .SelectSingleNode? Ich habe mich nämlich schon sehr weit ran getastet ohne das Webbrowser SE...

[crystal]

Hi,
ja, habe ich gelesen. Ich wollte nur meine Erfahrungen mit .Doc schildern und habe meinen Text so zusätzlich abgeschickt.

Die Variante, es mit XML zu versuchen, ist sicher auch gut, wenn man das Glück hat, dass alle interessierenden Quelltext-Elemente in einfache XML-Elemente aufgelöst werden (können).

Das ist aus meiner Sicht allerdings nur ein zusätzlicher Schritt, denn HTML ist ja auch schon eine "Markup Language" (Hypertext Transfer Markup Language), nur nicht ganz so strikt wie die "eXtended Markup Language".

Allerdings können wir bei google wohl davon ausgehen, dass die Übersetzung von HTML in XML gut und vollständig funktioniert. Ist halt nur ein zusätzlicher Schritt.

lg
crystal

[datekk]

Geschafft. Ich habe das XML einfach weggelassen.

Code [Auswählen] Erweitern


Function EntfernungKm(Startort As String, StartStraße As String) ', ZielOrt As String, ZielStraße As String) - Letzten Teil habe ich weg gelassen da bei mir das Ziel immer das selbe ist.

    On Error GoTo e

    Const BASE_URL = "http://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 = "****" 'kann auch PLZ sein.
    ZielStraße = "*******" 'z.B. Musterweg 5
   
   
       
    strStart = "origins=" & Startort & " " & StartStraße & " +DE&"
    strZiel = "destinations=" & ZielOrt & " " & ZielStraße & "+DE&mode=driving"
   
    URL = BASE_URL & strStart & strZiel
    Debug.Print URL
   
    With CreateObject("new:{88D96A0B-F192-11D4-A65F-0040963251E5}") 'was bedeutet dieser Zahlencode???
        .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, "")
    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



[Lachtaube]

Warum die XML-Auswertung nicht funktioniert, kann ich Dir ohne den verwendeten Code zu kennen, leider nicht mitteilen. Solltest Du einmal auf den Gedanken kommen, Zwischenziele einzupflegen, scheitert Dein Verfahren, weil distance und duration häufiger aufgeführt werden. Hier ist eine Version, die als Ergebnis einen JSON-String liefert. Die Auswertung erfolgt über das ScriptControl. Zusätzlich ist noch ein Dictionary-Objekt integriert, das alle Ergebnisse zwischenspeichert und unter Umständen die Abfragerei beschleunigt.

Code [Auswählen] Erweitern

Option Explicit

'// Legt die Position in den Ergebnis-Datenfeldern (Arrays)
'//     der Funktion DistMatrix  fest
Public Const DISTANCE& = 0
Public Const DURATION& = 1

Public Function DistMatrix(ByVal Origins$, ByVal Destinations$, _
                           ByRef Values&(), ByRef Texts$()) As Boolean

   '// GUIDs unserer Objekte
   Const CLSID_Dictionary$ = "{EE09B103-97E0-11CF-978F-00A02463E06F}"
   Const CLSID_ServerXMLHTTP60$ = "{88D96A0B-F192-11D4-A65F-0040963251E5}"
   Const CLSID_ScriptControl$ = "{0E59F1D5-1FBE-11D0-8FF2-00A0D10038BC}"

   Const BASEURL$ = _
         "http://maps.googleapis.com/maps/api/distancematrix" & _
         "/json?origins=%1&destinations=%2"
         
   Const JSON_BASE_PATH$ = "rows[0].elements[0]"

   Static urlCache As Object
   Dim URL$, Result$

   On Error Resume Next

   If urlCache Is Nothing Then
      '// Cache für JSON-Ergebnisse anlegen
      Set urlCache = CreateObject("new:" & CLSID_Dictionary)
   End If

   '// URL zusammenbauen
   URL$ = Replace(Replace(BASEURL, "%1", Origins), "%2", Destinations)

   If Not urlCache.Exists(URL) Then
      '// Server abfragen, weil der URL nicht im Cache vorliegt
      With CreateObject("new:" & CLSID_ServerXMLHTTP60)
         .Open "GET", URL, False
         '// damit Umlaute in den Anfragen richtig behandelt werden
         .setRequestHeader "Content-Type", "text/plain; charset=UTF-8"
         '// Anfrage an Server senden
         .send vbNullString
         '// Ergebnis holen
         Result = .responseText
      End With
      '// Ergebnis im Cache ablegen
      urlCache.Add URL, Result
   Else
      '// Ergebnis aus dem Cache verwenden
      Result = urlCache(URL)
   End If

   '// ScriptControl zum Auswerten heranziehen
   With CreateObject("new:" & CLSID_ScriptControl)
      '// JSON ist Javascript
      .Language = "JScript"
      '// JSON string auswerten lassen und in obj im ScriptControl speichern
      .Eval "var obj=(" & Result & ")"
      '// Feststellen, ob kein Fehler vorliegt
      If Not Err Then
         '// Datenfelder für die Ergebnisse dimensionieren
         ReDim Values(1): ReDim Texts(1)
         '// Ergebnisse auslesen und in die Argumente übertragen
         Values(DISTANCE) = .Eval("obj." & JSON_BASE_PATH & ".distance.value")
         Values(DURATION) = .Eval("obj." & JSON_BASE_PATH & ".duration.value")
         Texts(DISTANCE) = .Eval("obj." & JSON_BASE_PATH & ".distance.text")
         Texts(DURATION) = .Eval("obj." & JSON_BASE_PATH & ".duration.text")
      End If

   End With
   
   '// Erfolg signalisierten
   DistMatrix = Err = 0
End Function

Sub Beispiel()
   Const Start$ = "Mainkai 75, 60311 Frankfurt am Main, Deutschland"
   Const Ziel$ = "Rheinweg 20, 40489 Düsseldorf, Deutschland"

   Dim Values&(), Texts$()

   If Not DistMatrix(Start, Ziel, Values, Texts) Then
     
      MsgBox "Daten konnten nicht ermittelt werden"
   
   Else
     
      Dim h&, m&, s&, mtr&, km#
     
      s = Values(DURATION)
      m = s \ 60
      h = s \ 60 \ 60
     
      Debug.Print _
            "Fahrzeit: "; Texts(DURATION); _
            "; ="; s; "sec"; _
            "; ="; m; "min"; s - m * 60; "sec"; _
            "; ="; h; "hr"; m Mod 60; "min"; s - m * 60; "sec"
           
      mtr = Values(DISTANCE)
      km = mtr / 1000
      Debug.Print _
            "Entfernung: "; Texts(DISTANCE); _
            "; = "; Format$(mtr, "0,0## Meter"); _
            "; = "; Format$(km, "0,0.000 Kilometer")
   End If

End SubDie Ausgabe im VBA-Direktbereich schaut dann so aus:

Code [Auswählen] Erweitern

Fahrzeit: 2 Stunden, 31 Minuten; = 9083 sec; = 151 min 23 sec; = 2 hr 31 min 23 sec
Entfernung: 245 km = 244.692 Meter; = 244,692 Kilometer

[datekk]

Besten Dank Lachtaube. Das scheint Dein Spezialgebiet zu sein .

Was hat es eigentlich mit den GUIDs auf sich?

[Lachtaube]

Nun, Spezialgebiet will ich das nicht gerade nennen. Aber wenn man weiß, dass das ScriptControl Javascript auswerten kann - und JSON-Strings sind nichts anderes, ist dioese Lösung recht naheliegend. Wenn man tiefere Ausawertungen in JSON-Strings vornehmen muss, bietet es sich an, die JSON2-Implementierung nebst zwei Mini-Skripten in das ScriptControl einzuladen. Dann kann man auf die Hochkommata verzichten und eine direkte Auswertung in VBA fahren. Aus
"obj.rows[0].elements[0].distance.text" würde dann in VBA obj.rows(0).elements(0).distance.text werden.

Man könnte die Geschichte auch mit Early-Binding gestalten, was aber das Setzen von 3 Verweisen mit sich brächte. Die Verwendung von CLASSSIDs statt PROGIDs macht das Nachschlagen von Informationen in der Registry etwas kürzer. Wenn ich die PROGID "Scripting.Dictionary" statt der CLASSID "new:{EE09B103-97E0-11CF-978F-00A02463E06F}" als Argument für CreateObject verwende, wird in der Registry zunächst der Schlüssel der PROGID gesucht, unter dem dann die selbe CLASSID ausgelesen werden würde, wie sie oben steht.

[datekk]

... ich sehe, ich habe noch viel zu lernen. Manchmal macht es nur "Tut Tuuuuut..." und ich versteh nur Bahnhof... Aber Rom ist auch nicht an einem Tag erbaut worden. Das tröstet drüber hinweg