Hallo Zusammen,
wir bräuchten für unsere Kalkulation eine Entfernungsberechnung von einer bestimmten PLZ nach allen PLZ in Deutschland. z.B. Entfernung von München - Berlin, München - Hamburg, München - Dortmund usw.
Immer von der gleichen PLZ aus an alle PLZ in Deutschland.
Ich wollte als Basis diesen Code hier aus einem anderen Forum verwenden.
Dieser funktioniert leider nicht. Hat jemand eine Idee oder hat schon mal jemand sowas gebraucht?
wir bräuchten für unsere Kalkulation eine Entfernungsberechnung von einer bestimmten PLZ nach allen PLZ in Deutschland. z.B. Entfernung von München - Berlin, München - Hamburg, München - Dortmund usw.
Immer von der gleichen PLZ aus an alle PLZ in Deutschland.
Ich wollte als Basis diesen Code hier aus einem anderen Forum verwenden.
VB.NET-Quellcode
- ' Bestimmung der Entfernung zwischen Orten
- 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 = False ' 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 If theMap = "Google" Then ' Google-Maps
- .Navigate "http://maps.google.de/maps?f=d&hl=de&saddr=" & von & "&daddr=" & _
- nach & "&output=html" Else ' Microsoft-Maps
- .Navigate "http://maps.msn.de/(drkyj4nqdtrplraqamd5lf55)/directionsfind.aspx"
- End If ' 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
- For i = LBound(strTeile) To UBound(strTeile)
- 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 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 = EntfernungEnd Function
- PrivateSub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
- Dim km AsString
- km = getDistance("Google", "97708", "Bad Bocklet", "97702")
- If Len(km) > 0 Then
- MsgBox("Die Entfernung beträgt " & km & " km")
- MsgBox("Entfernung konnte nicht ermittelt werden!", vbExclamation)
- EndIf
- EndSub
Dieser funktioniert leider nicht. Hat jemand eine Idee oder hat schon mal jemand sowas gebraucht?