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 |