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
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:
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 :)
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
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...
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
Geschafft. Ich habe das XML einfach weggelassen.
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
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.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: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
Besten Dank Lachtaube. Das scheint Dein Spezialgebiet zu sein ;).
Was hat es eigentlich mit den GUIDs auf sich?
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.
... 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 :)