ist es möglich die Entfernung (die Route) zu berechnen?
Vielen Dank
Detlef
Code:
[Cc][+][-]
Option Explicit
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Type DIST_STRUCT
Start As String ' Mehrere durch "/" getrennt eingeben
Ziel As String
LDist As String
FDist As String
LTime As String
FTime As String
End Type
Private Sub EntfernungErmitteln()
Dim tDist As DIST_STRUCT
Dim WS As Worksheet
Set WS = Worksheets("Tabelle1")
With tDist
.Start = WS.Range("B3").Value
.Ziel = WS.Range("C3").Value
GetDistance tDist
WS.Range("E3").Value = .FDist
WS.Range("G3").Value = .LDist
WS.Range("F3").Value = .FTime
WS.Range("H3").Value = .LTime
End With
End Sub
Private Sub GetDistance(tDist As DIST_STRUCT)
' Get-Methode
Dim oDoc As Object, i As Integer
With CreateObject("InternetExplorer.Application")
'.Visible = True
.Navigate "http://www.luftlinie.org/" _
& tDist.Start & "/" & tDist.Ziel ' Zur Url surfen
While Not .readyState = 4: DoEvents: Wend ' Warten bis Seite geladen ist
On Error Resume Next
Set oDoc = .Document
With tDist
If Not .Start Like "#####*" Then .Start = ""
If Not .Ziel Like "#####*" Then .Ziel = ""
Do
Sleep 100: i = i + 1
.FDist = oDoc.getElementById("strck").outertext
If Not .FDist Like "*--*" Then Exit Do
If i > 50 Then Exit Do
Loop
.LDist = oDoc.getElementsByClassName("value km")(0).outertext & " km"
.LTime = oDoc.getElementsByClassName("directionsResultTime0")(0).outertext
.FTime = oDoc.getElementsByClassName("directionsResultTimeTotal")(0).outertext
.Start = Trim$(.Start & " " & oDoc.getElementsByClassName("regions")(0).outertext)
.Ziel = Trim$(.Ziel & " " & oDoc.getElementsByClassName("regions")(2).outertext)
End With
.Quit ' IE schließen
End With
End Sub
While Not .readyState = 4: DoEvents: Wend ' Warten bis Seite geladen ist
Detlef.Navigate "http://www.luftlinie.org/" _
& tDist.Start & "/" & tDist.Ziel ' Zur Url surfen
.Visible = True
While Not .readyState = 4: DoEvents: Wend ' Warten bis Seite geladen ist