|
| |
 | In diesem Forum haben Sie die Möglichkeit Kommentare, Fragen und Verbesserungsvorschläge zu den im vb@rchiv gelisteten Tipps und Workshops zu posten.
Hinweis:
Ein neues Thema kann immer nur über die jeweilige Tipps & Tricks bzw. Workshop Seite eröffnet werden! |
Fragen zu Tipps & Tricks und Workshops im vb@rchiv| Tipp 1916: Online-Entfernungsermittlung zwischen zwei Orten | |  | | Autor: gunthard |  Tipp anzeigenDatum: 30.12.08 12:25 |
| Hallo,
bei einigen Anwendern wird bei der Entfernungsberechnung der Browser sichtbar geöffnet, und die Entfernungsberechnung und die Routenbeschreibung wird angezeigt.
Die Werte werden aber nicht an das ausgeführte Programm zurückgegeben.
Ich habe festgestellt, dass der von den Anwendern voreingestellte Browser weder Firefox noch der MS IE ist.
Wie kann ich verhindern, das der Browser geöffnet wird?
Danke für jeden Tipp
Gunthard | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: gunthard | | Datum: 31.12.08 00:44 |
| Habe es mal mit dem Parameter 0 am Ende probiert:
IEApp.navigate "http://maps.google.de/maps?f=d&hl=de&saddr=" & von & "&daddr=" _
& nach & "&output=html", 0 Könnte das die Lösung sein? Ist das der Parameter für 'nicht anzeigen'?
Gunthard | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: dh | | Datum: 04.01.09 11:07 |
| Hallo,
ja eigentlich setzt die Zeile .Visible=false das entsprechende Browserfenster unsichtbar.
Ich habe das Programm nur mit IE und MozillaFirefox getestet, deshalb kann ich dir da nicht weiter helfen, sorry.
Gruß-
Salzburger | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: gunthard | | Datum: 12.01.09 11:52 |
| Es hat sich wohl etwas by Google geändert:
In IEDocument.Body.innerText gibt es nicht mehr "Fahrt:"
Wenn ich die Zeile:
If InStr(1, strTeile(i), "Fahrt:", vbTextCompare) > 0 Then
ändere in:
If InStr(1, strTeile(i), " km – ca. ", vbTextCompare) > 0 Then
funktioniert es wieder.
Gruß
Gunthard | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: gunthard | | Datum: 12.01.09 13:34 |
| Hallo Dietrich,
bei mir wird der IExplorer nicht geöffnet.
Jetzt melden sich aber immer wieder andere User, bei denen sich der IExplorer öffnet und dann die Entfernung etc. nicht übernommen wird.
Kann das an den Einstellungen im IExplorer liegen?
Gruss
Gunthard | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: binwo | | Datum: 24.09.10 18:21 |
| Hallo Gunthard,
dank deiner Überarbeitung hat der Code für mich das letzte halbe Jahr gute Dienste geleistet allerdings muss sich bei google wieder was verändert haben. Wenn ich mir die Aktion "visible" anschaue macht er auch alles richtig nur wird mir die Entfernung nicht richtig zurückgegeben.
Was läuft da falsch?
Über einen Tipp würde ich mich sehr freuen!!
lg
gunther | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: thuring | | Datum: 25.09.10 09:47 |
| Hallo,
ja, GoogleMaps hat immer mal den Seitencode verändert.
Ich habe folgende Änderung am Tipp-Code vorgenommen:
Im Code gibt es die Stelle 'Inhalt des Webseiten-Dok auslesen und in Zeilöen splitten, dort zwischen
If theMap = "Google" Then und Else den Code durch folgenden ersetzen:
Dim seekStr As String = "Route nach"
'die Entfernung auslesen
For i = LBound(strTeile) To UBound(strTeile)
Select Case art
Case 0
If InStr(1, strTeile(i), "Fahrt:", vbTextCompare) _
> 0 Then
Entfernung = Trim(Replace(strTeile(i), _
"Fahrt:", ""))
f = InStr(Entfernung, " km")
Entfernung = Left(Entfernung, f - 1)
Exit For
End If
Case Else
f = InStr(1, strTeile(i), seekStr, vbTextCompare)
If f > 0 Then
Dim z As String = strTeile(i + 3)
Entfernung = z.Substring(0, z.IndexOf("km") - 1)
Exit For
End If
End Select
Next iKnackpunkt ist dabei die Zeile Dim Z AS String=...
Hier wird auf die dritte Zeile nach der Zeile mit "Route nach" positioniert und die Entfernung herausgelesen.
Grüße von Tippautor-
Salzburger | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: binwo | | Datum: 29.09.10 21:03 |
| Hallo Tippautor,
vielen Dank für deine schnelle Antwort. Ich habe es jetzt erst geschafft es auszuprobieren! Aber leider funktioniert es nicht. Zwei Zeilen deines neuen Codes werden rot beim Einfügen
1. Dim seekStr As String = "Route nach"
2. Dim z As String = strTeile(i + 3)
beides Mal wird ein "Anwendungsende erwartet"
Nun stehe ich davor wie das Schwein vorm Uhrwerk und frage mich: watt los mit die Chronograph?!
über Hilfe würde ich mich natürlich sehr freuen!!!
hier das ist mein kompletter "neuer Code":
on getDistance(theMap As String, _
Optional plz1 As String = "", Optional plz2 As String = "", _
Optional ort1 As String = "", Optional ort2 As String = "", _
Optional land1 As String = "", Optional land2 As String = "")
Dim IEApp As Object
Dim IEDocument As Object
Dim strURL As String
Dim Entfernung As String
Dim von As String
Dim nach As String
Dim sa As Variant
Dim se As Variant
Dim strTeile As Variant
Dim i As Long
Dim f As Long
' IE-Instanz erstellen
Set IEApp = CreateObject("InternetExplorer.Application")
With IEApp
' IE-Fenster unsichtbar lassen
.Visible = True
' von PLZ, Ort, Land
von = plz1 & IIf(Len(ort1) > 0, "," & ort1, "") & IIf(Len(land1) > 0, "," & land1, "")
' nach PLZ, Ort, Land
nach = plz2 & IIf(Len(ort2) > 0, "," & ort2, "") & IIf(Len(land2) > 0, "," & land2, "")
' URL aufrufen
.Navigate "http://maps.google.de/maps?f=d&hl=de&saddr=" & von & "&daddr=" & _
nach & "&output=html"
' Warten, bis Seite geladen
Do: Loop Until .Busy = False
Do: Loop Until .Busy = False
While IEApp.Busy: Wend
' IE-Dokument
Set IEDocument = .Document
End With
With IEDocument
' Warten, bis fertig angezeigt
Do: Loop Until .readyState <> 4
If theMap <> "Google" Then
sa = Split(von, ","): se = Split(nach, ",")
'PLZ in die Dokument-Felder eintragen
.getElementById("RouteControl_StartZipText").Value = sa(0)
.getElementById("RouteControl_EndZipText").Value = se(0)
' Ort in die Dokument-Felder eintragen
If Len(ort1) > 0 Then .getElementById("RouteControl_StartCityText").Value = sa(1)
If Len(ort2) > 0 Then .getElementById("RouteControl_EndCityText").Value = se(1)
' Berechnung klicken
.All.RouteControl_AmbiguousButton.Click
End If
End With
' Warten...
Do
DoEvents
Loop Until IEDocument.readyState <> 4
' Inhalt des Webseiten-Dokuments auslesen und in Zeilen aufplitten
strTeile = Split(IEDocument.Body.innerText, vbCrLf)
If theMap = "Google" Then
Dim seekStr As String = "Route nach"
'die Entfernung auslesen
For i = LBound(strTeile) To UBound(strTeile)
Select Case art
Case 0
If InStr(1, strTeile(i), "Fahrt:", vbTextCompare) _
> 0 Then
Entfernung = Trim(Replace(strTeile(i), _
"Fahrt:", ""))
f = InStr(Entfernung, " km")
Entfernung = Left(Entfernung, f - 1)
Exit For
End If
Case Else
f = InStr(1, strTeile(i), seekStr, vbTextCompare)
If f > 0 Then
Dim z As String = strTeile(i + 3)
Entfernung = z.Substring(0, z.IndexOf("km") - 1)
Exit For
End If
End Select
Next i
Else
For i = LBound(strTeile) To UBound(strTeile)
If InStr(1, strTeile(i), "Entfernung:", vbTextCompare) > 0 Then
Entfernung = Replace(Replace(strTeile(i), "Gesamtentfernung: ", ""), _
" Kilometer", "")
Exit For
End If
Next i
End If
Entfernung = Replace(Entfernung, ",", ".")
If theMap <> "Google" Then IEApp.Quit
' Objekte zerstören
Set IEDocument = Nothing
Set IEApp = Nothing
' Rückgabewert (KM-Entfernung)
getDistance = Entfernung
End Function
| |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: binwo | | Datum: 29.09.10 21:05 |
| ich hoffe der code wird jetzt lesbar angezeigt.
Public Function getDistance(theMap As String, _
Optional plz1 As String = "", Optional plz2 As String = "", _
Optional ort1 As String = "", Optional ort2 As String = "", _
Optional land1 As String = "", Optional land2 As String = "")
Dim IEApp As Object
Dim IEDocument As Object
Dim strURL As String
Dim Entfernung As String
Dim von As String
Dim nach As String
Dim sa As Variant
Dim se As Variant
Dim strTeile As Variant
Dim i As Long
Dim f As Long
' IE-Instanz erstellen
Set IEApp = CreateObject("InternetExplorer.Application")
With IEApp
' IE-Fenster unsichtbar lassen
.Visible = True
' von PLZ, Ort, Land
von = plz1 & IIf(Len(ort1) > 0, "," & ort1, "") & IIf(Len(land1) > 0, _
"," & land1, "")
' nach PLZ, Ort, Land
nach = plz2 & IIf(Len(ort2) > 0, "," & ort2, "") & IIf(Len(land2) > _
0, "," & land2, "")
' URL aufrufen
.Navigate "http://maps.google.de/maps?f=d&hl=de&saddr=" & von & "&daddr=" _
& _
nach & "&output=html"
' Warten, bis Seite geladen
Do: Loop Until .Busy = False
Do: Loop Until .Busy = False
While IEApp.Busy: Wend
' IE-Dokument
Set IEDocument = .Document
End With
With IEDocument
' Warten, bis fertig angezeigt
Do: Loop Until .readyState <> 4
If theMap <> "Google" Then
sa = Split(von, ","): se = Split(nach, ",")
'PLZ in die Dokument-Felder eintragen
.getElementById("RouteControl_StartZipText").Value = sa(0)
.getElementById("RouteControl_EndZipText").Value = se(0)
' Ort in die Dokument-Felder eintragen
If Len(ort1) > 0 Then .getElementById( _
"RouteControl_StartCityText").Value = sa(1)
If Len(ort2) > 0 Then .getElementById( _
"RouteControl_EndCityText").Value = se(1)
' Berechnung klicken
.All.RouteControl_AmbiguousButton.Click
End If
End With
' Warten...
Do
DoEvents
Loop Until IEDocument.readyState <> 4
' Inhalt des Webseiten-Dokuments auslesen und in Zeilen aufplitten
strTeile = Split(IEDocument.Body.innerText, vbCrLf)
If theMap = "Google" Then
Dim seekStr As String = "Route nach"
'die Entfernung auslesen
For i = LBound(strTeile) To UBound(strTeile)
Select Case art
Case 0
If InStr(1, strTeile(i), "Fahrt:", vbTextCompare) _
> 0 Then
Entfernung = Trim(Replace(strTeile(i), _
"Fahrt:", ""))
f = InStr(Entfernung, " km")
Entfernung = Left(Entfernung, f - 1)
Exit For
End If
Case Else
f = InStr(1, strTeile(i), seekStr, vbTextCompare)
If f > 0 Then
Dim z As String = strTeile(i + 3)
Entfernung = z.Substring(0, z.IndexOf("km") - 1)
Exit For
End If
End Select
Next i
Else
For i = LBound(strTeile) To UBound(strTeile)
If InStr(1, strTeile(i), "Entfernung:", vbTextCompare) > 0 Then
Entfernung = Replace(Replace(strTeile(i), "Gesamtentfernung: ", ""), _
" Kilometer", "")
Exit For
End If
Next i
End If
Entfernung = Replace(Entfernung, ",", ".")
If theMap <> "Google" Then IEApp.Quit
' Objekte zerstören
Set IEDocument = Nothing
Set IEApp = Nothing
' Rückgabewert (KM-Entfernung)
getDistance = Entfernung
End Function | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: thuring | | Datum: 29.09.10 22:13 |
| Hallo,
sorry, aber es ist meine Unachtsamkeit...
Die Fehler bei dir werden angezeigt, weil ich den Code in VB.net anwende und auch darin geändert habe.
Du musst am Anfang der Funktion in dem Vereinbarungsblock ergänzen:
Dim seekStr as String
Dim z as String
und dann die bei dir rot gezeigten Zeilen ändern in
seekStr = "Route nach"
z = strTeile(i+3)
Grüße-
Salzburger | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: binwo | | Datum: 30.09.10 10:59 |
| Hallo zurück,
dass hatte ich mir schon gedacht und es auch so geändert, allerdings sagte er mir dann bei:
"z.IndexOf("km") - 1)" -> "Ungültiger Bezeichner" wobei das "z" markiert war.
Und da dachte ich mir, dass es etwas komplizierter ist.
Was kann es sein?!
wie immer dankbar:
Uwe | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: thuring | | Datum: 30.09.10 22:15 |
| Hallo,
z.IndexOf("km")
bitte ändern in
InStr(z, "km")
Gruß-
Salzburger | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: binwo | | Datum: 01.10.10 15:16 |
| Hallo Salzburger,
Danke für Deine Mühe! Es harkt aber leider noch immer. Und zwar markiert er das "z" bei "z.Substring" und sagt "Fehler beim Kompilieren - Ungültiger Bezeichner"
Aber "z" wurde doch schon als "String" bezeichnet?!
für die "übersichtlichkeit" habe ich nochmal den "aktuellesten" COde gepostet:
VG
Uwe
Public Function getDistance(theMap As String, _
Optional plz1 As String = "", Optional plz2 As String = "", _
Optional ort1 As String = "", Optional ort2 As String = "", _
Optional land1 As String = "", Optional land2 As String = "")
Dim IEApp As Object
Dim IEDocument As Object
Dim strURL As String
Dim Entfernung As String
Dim von As String
Dim nach As String
Dim sa As Variant
Dim se As Variant
Dim strTeile As Variant
Dim i As Long
Dim f As Long
Dim seekStr As String
Dim z As String
' IE-Instanz erstellen
Set IEApp = CreateObject("InternetExplorer.Application")
With IEApp
' IE-Fenster unsichtbar lassen
.Visible = True
' von PLZ, Ort, Land
von = plz1 & IIf(Len(ort1) > 0, "," & ort1, "") & IIf(Len(land1) > 0, _
"," & land1, "")
' nach PLZ, Ort, Land
nach = plz2 & IIf(Len(ort2) > 0, "," & ort2, "") & IIf(Len(land2) > _
0, "," & land2, "")
' URL aufrufen
.Navigate "http://maps.google.de/maps?f=d&hl=de&saddr=" & von & "&daddr=" _
& _
nach & "&output=html"
' Warten, bis Seite geladen
Do: Loop Until .Busy = False
Do: Loop Until .Busy = False
While IEApp.Busy: Wend
' IE-Dokument
Set IEDocument = .Document
End With
With IEDocument
' Warten, bis fertig angezeigt
Do: Loop Until .readyState <> 4
If theMap <> "Google" Then
sa = Split(von, ","): se = Split(nach, ",")
'PLZ in die Dokument-Felder eintragen
.getElementById("RouteControl_StartZipText").Value = sa(0)
.getElementById("RouteControl_EndZipText").Value = se(0)
' Ort in die Dokument-Felder eintragen
If Len(ort1) > 0 Then .getElementById( _
"RouteControl_StartCityText").Value = sa(1)
If Len(ort2) > 0 Then .getElementById( _
"RouteControl_EndCityText").Value = se(1)
' Berechnung klicken
.All.RouteControl_AmbiguousButton.Click
End If
End With
' Warten...
Do
DoEvents
Loop Until IEDocument.readyState <> 4
' Inhalt des Webseiten-Dokuments auslesen und in Zeilen aufplitten
strTeile = Split(IEDocument.Body.innerText, vbCrLf)
If theMap = "Google" Then
seekStr = "Route nach"
'die Entfernung auslesen
For i = LBound(strTeile) To UBound(strTeile)
Select Case art
Case 0
If InStr(1, strTeile(i), "Fahrt:", vbTextCompare) _
> 0 Then
Entfernung = Trim(Replace(strTeile(i), _
"Fahrt:", ""))
f = InStr(Entfernung, " km")
Entfernung = Left(Entfernung, f - 1)
Exit For
End If
Case Else
f = InStr(1, strTeile(i), seekStr, vbTextCompare)
If f > 0 Then
z = strTeile(i + 3)
Entfernung = z.Substring(0, InStr(z, "km" - 1))
Exit For
End If
End Select
Next i
Else
For i = LBound(strTeile) To UBound(strTeile)
If InStr(1, strTeile(i), "Entfernung:", vbTextCompare) > 0 Then
Entfernung = Replace(Replace(strTeile(i), "Gesamtentfernung: ", ""), _
" Kilometer", "")
Exit For
End If
Next i
End If
Entfernung = Replace(Entfernung, ",", ".")
If theMap <> "Google" Then IEApp.Quit
' Objekte zerstören
Set IEDocument = Nothing
Set IEApp = Nothing
' Rückgabewert (KM-Entfernung)
getDistance = Entfernung
End Function | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: gunthard | | Datum: 01.10.10 21:02 |
| Ich habe den Code mal überarbeitet und gekürzt. Allerdings habe ich nur wenige Tests vorgenommen.
Gunthard
Private Sub Form_Load()
Dim Route As String
Dim KM As Integer
Dim Stunden As Integer
Dim Minuten As String
Dim Start As Integer
Dim AufSplitten() As String
Route = getDistance("Google", "23847", "20146", "Steinhorst", "Hamburg", _
"", "Binderstraße 13", "Deutschland", "Deutschland")
Debug.Print Route
Start = InStr(Route, "Stunde")
If Start > 0 Then
Stunden = Val(Route)
Start = InStr(Route, "Stunden.")
If Start > 0 Then
Route = Trim$(Mid$(Route, Start + 8, 100))
End If
Start = InStr(Route, "Stunden")
If Start > 0 Then
Route = Trim$(Mid$(Route, Start + 7, 100))
End If
Start = InStr(Route, "Stunde")
If Start > 0 Then
Route = Trim$(Mid$(Route, Start + 6, 100))
End If
End If
Start = InStr(Route, "Minute")
If Start > 0 Then
Minuten = Val(Route)
End If
AufSplitten = Split(Route, vbCrLf)
Start = InStr(AufSplitten(1), "km")
If Start > 0 Then
KM = Val(AufSplitten(1))
End If
Debug.Print "Stunden="; Stunden
Debug.Print "Minuten="; Minuten
Debug.Print "KM="; KM
End Sub
Public Function getDistance(theMap As String, Optional plz1 As String = "", _
Optional plz2 As String = "", Optional ort1 As String = "", Optional ort2 As _
String = "", Optional Strasse1 As String = "", Optional Strasse2 As String = _
"", Optional land1 As String = "", Optional land2 As String = "")
Dim IEApp As Object
Dim IEDocument As Object
Dim strURL As String
Dim Entfernung As String
Dim von As String
Dim nach As String
' IE-Instanz erstellen
Set IEApp = CreateObject("InternetExplorer.Application")
With IEApp
' IE-Fenster unsichtbar lassen
.Visible = False
' von PLZ, Ort, Land
von = plz1 & IIf(Len(ort1) > 0, "," & ort1, "") & IIf(Len(Strasse1) _
> 0, "," & Strasse1, "") & IIf(Len(land1) > 0, "," & land1, "")
' nach PLZ, Ort, Land
nach = plz2 & IIf(Len(ort2) > 0, "," & ort2, "") & IIf(Len(Strasse1) _
> 0, "," & Strasse2, "") & IIf(Len(land2) > 0, "," & land2, "")
' URL aufrufen
.Navigate "http://maps.google.de/maps?f=d&hl=de&saddr=" & von & _
"&daddr=" & nach & "&output=html"
' Warten, bis Seite geladen
Do: Loop Until .Busy = False
Do: Loop Until .Busy = False
While IEApp.Busy: Wend
' IE-Dokument
Set IEDocument = .Document
End With
' Warten...
Do
DoEvents
Loop Until IEDocument.readyState <> 4
DoEvents
Dim Start As Integer
Dim GoogleText As String
DoEvents
GoogleText = IEDocument.Body.innerText
Start = InStr(GoogleText, "Vorgeschlagene Routen")
DoEvents
Debug.Print "start="; Start
Entfernung = Mid$(GoogleText, Start + 24, 40)
'
Entfernung = Replace(Entfernung, ",", ".")
If theMap <> "Google" Then IEApp.Quit
' Objekte zerstören
Set IEDocument = Nothing
Set IEApp = Nothing
' Rückgabewert (KM-Entfernung)
getDistance = Entfernung
End Function | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: gunthard | | Datum: 02.10.10 11:18 |
| z.Zt. ist der Zugriff auf www.maps.google.de langsam bzw. gar nicht möglich.
Alternative:
Zugriff über www.maps.google.com. Funktioniert schnell, es muss aber das Land eingegeben werden.
Hier der gesamte Code:
Private Sub Form_Load()
Dim Route As String
Dim KM As Integer
Dim Stunden As Integer
Dim Minuten As Integer
Dim Start As Integer
Dim AufSplitten() As String
Route = getDistance("Google", "23847", "20146", "Steinhorst", "Hamburg", _
"Mühlenbrook 1", "Binderstraße 13", "Deutschland", "Deutschland")
Debug.Print Route
Start = InStr(Route, "Stunde")
If Start > 0 Then
Stunden = Val(Route)
Start = InStr(Route, "Stunden.")
If Start > 0 Then
Route = Trim$(Mid$(Route, Start + 8, 100))
End If
Start = InStr(Route, "Stunden")
If Start > 0 Then
Route = Trim$(Mid$(Route, Start + 7, 100))
End If
Start = InStr(Route, "Stunde")
If Start > 0 Then
Route = Trim$(Mid$(Route, Start + 6, 100))
End If
End If
Start = InStr(Route, "Minute")
If Start > 0 Then
Minuten = Val(Route)
End If
AufSplitten = Split(Route, vbCrLf)
Start = InStr(AufSplitten(1), "km")
If Start > 0 Then
KM = Val(AufSplitten(1))
End If
Debug.Print "Stunden="; Stunden
Debug.Print "Minuten="; Minuten
Debug.Print "KM="; KM
End Sub
Public Function getDistance(theMap As String, Optional plz1 As String = "", _
Optional plz2 As String = "", Optional ort1 As String = "", Optional ort2 As _
String = "", Optional Strasse1 As String = "", Optional Strasse2 As String = _
"", Optional land1 As String = "", Optional land2 As String = "")
Dim IEApp As Object
Dim IEDocument As Object
Dim strURL As String
Dim Entfernung As String
Dim von As String
Dim nach As String
' IE-Instanz erstellen
Set IEApp = CreateObject("InternetExplorer.Application")
With IEApp
' IE-Fenster unsichtbar lassen
.Visible = True
' von PLZ, Ort, Land
von = plz1 & IIf(Len(ort1) > 0, "," & ort1, "") & IIf(Len(Strasse1) _
> 0, "," & Strasse1, "") & IIf(Len(land1) > 0, "," & land1, "")
' nach PLZ, Ort, Land
nach = plz2 & IIf(Len(ort2) > 0, "," & ort2, "") & IIf(Len(Strasse1) _
> 0, "," & Strasse2, "") & IIf(Len(land2) > 0, "," & land2, "")
' URL aufrufen
.Navigate "http://maps.google.com/maps?f=d&hl=de&saddr=" & von & _
"&daddr=" & nach & "&output=html"
' Warten, bis Seite geladen
Do: Loop Until .Busy = False
Do: Loop Until .Busy = False
While IEApp.Busy: Wend
' IE-Dokument
Set IEDocument = .Document
End With
' Warten...
Do
DoEvents
Loop Until IEDocument.readyState <> 4
DoEvents
Dim Start As Integer
Dim GoogleText As String
DoEvents
GoogleText = IEDocument.Body.innerText
Start = InStr(GoogleText, "Vorgeschlagene Routen")
DoEvents
Debug.Print "start="; Start
Entfernung = Mid$(GoogleText, Start + 24, 40)
If Start = 0 Then
Entfernung = "Fehler: Route konnte nicht berechnet werden."
End If
'
Entfernung = Replace(Entfernung, ",", ".")
If theMap <> "Google" Then IEApp.Quit
' Objekte zerstören
Set IEDocument = Nothing
Set IEApp = Nothing
' Rückgabewert (KM-Entfernung)
getDistance = Entfernung
End Function
Beitrag wurde zuletzt am 02.10.10 um 11:49:37 editiert. | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: gunthard | | Datum: 02.10.10 16:18 |
| Die Berechnung über den IExplorer laufen zu lassen, führte bei mir immer wieder zum Timeout.
Stattdessen benutze ich jetzt den VB-WebBrowser.
Ihr könnt Euch das gesamte Projekt downloaden:
http://www.showtime.de/EntfernungBerechnen.zip
Es werden die Kilometer und die Fahrtzeit in Stunden und Minuten ausgegeben.
Gunthard | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: thuring | | Datum: 02.10.10 16:52 |
| Seitdem ich den Tipp entwickelte und selbst anwende, benutze ich als Browser MozillaFirefox.
Damit hatte ich noch nie ein Timeout-Problem.
Grüße-
Salzburger | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: gunthard | | Datum: 04.10.10 09:17 |
| hallo thuring,
das verstehe ich jetzt nicht so ganz.
wird mit:
Set IEApp = CreateObject("InternetExplorer.Application")bei Dir der MozillaFirefox-Browser geöffnet???
Gunthard | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: Hug Me | | Datum: 11.05.15 16:05 |
| Hallo zusammen.
ich bin noch immer bei VB 6.0 ..... (ich weiß wir haben schon 2015 ) !
Leider funktionirt das Toll hier bei mir nicht....
Es kommt immer "Entfernung konnte nicht ermittelt werden!"
Is jemand so lieb und schaut da noch mal drüfer ?
Vielen Dank im Vorraus. Nick | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: Hug Me | | Datum: 11.05.15 23:25 |
| Hallo Gunthard,
ich weiß der Link ist von 2010, kannst Du den dennoch wieder online stellen ?
Vielen Dank
Nick | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: gunthard | | Datum: 11.05.15 23:46 |
| Hallo Nick,
ich versuche die Datei zu finden.
Dann stelle ich sie wieder online.
G. | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: gunthard | | Datum: 11.05.15 23:48 |
| Hallo Nick,
die Datei ist online
G. | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: Hug Me | | Datum: 12.05.15 00:35 |
| Ganz GROSSES DANKE für Deine schnelle Hilfe !
Hast das schon was guten geschrieben !!!
Gute Nacht, Nick | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: Hug Me | | Datum: 12.05.15 01:27 |
| Hallo Gunthard,
google hat mal wieder etwas am String geändert.....
Sag magst Du noch EIN mal über Deinen Code schauen ? Und event. updaten ?
Gruß und Dank, Nick
PS: Sonst ist das aber echt Super !!! | |
| Re: Online-Entfernungsermittlung zwischen zwei Orten | | | | Autor: gunthard | | Datum: 16.08.15 19:11 |
| Das WebBrowser-Control kann nicht mehr auf GoogleMaps zugreifen.
Deshalb eine Lösung ohne das Control.
Option Explicit
'Entfernungsberechnung über Google Maps
'ohne WevBrowser
'Rückfragen an Gunthard Pupke info@showtime.de
Private Sub Form_Load()
Dim GoogleText, Von, Nach, Zeit, Stunden, Minuten, KM As String
Dim Start As Integer
'verschiedene Von - Nach
Von = "D 23847, Mühlenbrook 1"
Nach = "D 20144, Kielortallee 8"
Nach = "D 21614, Apensenerstr. 100a"
Von = "DK Kopenhagen"
Nach = "D Rosenheim"
GoogleText = GetHTMLCode("https://www.google.de/maps/dir/," & Von & "/" & _
Nach)
'Kilometer extrahieren
Start = InStr(GoogleText, "km")
If Start > 0 Then
KM = Mid$(GoogleText, Start - 8, 12)
Debug.Print "1-", KM
Start = InStr(KM, Chr$(34))
If Start > 0 Then
KM = Mid$(KM, Start + 1, 12)
Debug.Print "2-", KM
Start = InStr(KM, Chr$(34))
If Start > 0 Then
KM = Mid$(KM, 1, Start - 1)
Debug.Print "3-", KM
End If
Start = InStr(KM, "km")
If Start > 0 Then
KM = Left$(KM, Start - 2)
Debug.Print "4-"; KM; "-"
End If
End If
End If
'Fahrzeit extrahieren
Start = InStr(GoogleText, "Min.")
If Start > 0 Then
Zeit = Mid$(GoogleText, Start - 12, 20)
Debug.Print "5-", Zeit
Start = InStr(Zeit, Chr$(34))
If Start > 0 Then
Zeit = Mid$(Zeit, Start + 1, 20)
Debug.Print "6-", Zeit
Start = InStr(Zeit, Chr$(34))
If Start > 0 Then
Zeit = Mid$(Zeit, 1, Start - 1)
Debug.Print "7-", Zeit
End If
'Zerlegen in Stunden
Start = InStr(Zeit, "Std.")
If Start > 0 Then
Stunden = Left$(Zeit, 8)
Start = InStr(Stunden, " ")
If Start > 0 Then
Stunden = Left$(Stunden, Start - 1)
Debug.Print "8-"; Stunden; "-"
Else
Stunden = 0
End If
End If
'Zerlegen in Minuten
Start = InStr(Zeit, " Min.")
If Start > 0 Then
Minuten = Mid$(Zeit, Start - 2, 2)
Debug.Print "9-"; Minuten; "-"
Minuten = Trim$(Minuten)
Debug.Print "10-"; Minuten; "-"
Else
Minuten = 0
End If
End If
End If
Debug.Print "KM ="; KM
Debug.Print "Std.="; Stunden
Debug.Print "Min.="; Minuten
End Sub
Function GetHTMLCode(strURL) As String
Dim strReturn ' As String
Dim objHTTP ' As MSXML.XMLHTTPRequest
If Len(strURL) = 0 Then Exit Function
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
objHTTP.open "GET", strURL, False
objHTTP.send 'Get it.
strReturn = objHTTP.responseText
Set objHTTP = Nothing
GetHTMLCode = strReturn
End Function | |
| Sie sind nicht angemeldet!
Um einen neuen Beitrag schreiben zu können, müssen Sie sich zunächst anmelden.
 Einloggen | Neu registrieren |
 |
|
sevISDN 1.0 
Überwachung aller eingehender Anrufe!
Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Weitere InfosTipp des Monats Neu! sevEingabe 3.0 
Einfach stark!
Ein einziges Eingabe-Control für alle benötigten Eingabetypen und -formate, inkl. Kalender-, Taschenrechner und Floskelfunktion, mehrspaltige ComboBox mit DB-Anbindung, ImageComboBox u.v.m. Weitere Infos
|
April 2024
Sie sind aktuell nicht angemeldet.