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. |