Es geht immer noch um die Entfernung zwischen zwei Adressen (zum einen um die Fahrtzeit und zum anderen um die Luftlinie).
Um das Thema mit dem API-Key als erstes anzusprechen, möchte ich mal nachfragen ob es ein kleines "Programm" (es lief ziemlich viel über Excelformeln statt über VBA) gibt um die Funktionalität des mit vorliegenden API-Keys überhaupt mal zu testen oder ob dieser aufgrund irgendeiner Einstellung noch nie richtig funktioniert hat.
In diesem Beitrag wird auch über den Google API-Key geschrieben.
Falls Du mit dem API-Key nicht weiterkommen solltest, gibt es hier noch eine Alternative, die mit dem IE und bei bestimmten Bedingungen auch mit dem Edge funktioniert. Findest Du auch (etwas älter) bei den Komplettlösungen als Funktion hier im Forum.
Code:
Option Explicit
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 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
Sub EntfernungErmitteln() Dim tDist As DIST_STRUCT, iZeile As Long
With tDist Application.StatusBar = "" .Start = Range("A1").Value For iZeile = 2 To Cells(Rows.Count, "A").End(xlUp).Row If Cells(iZeile, "B").Value = "" Then .Ziel = Cells(iZeile, "A").Value Application.StatusBar = "Strecke " & .Start & " nach " & .Ziel & " wird ermittelt" GetDistance tDist DoEvents Cells(iZeile, "B").Value = .FDist Cells(iZeile, "C").Value = .FTime End If Next iZeile End With MsgBox "Fertig!", vbInformation, "Strecken ermitteln" End Sub
Sub GetDistance(tDist As DIST_STRUCT) ' Get-Methode Dim oDoc As Object, i As Integer
With CreateObject("InternetExplorer.Application") .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 .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
Hier eine Mappe, die ich letztens im ms-office-forum hochgeladen habe.
Dabei wird der API-Key, da ja eine versehentliche Weitergabe Kosten verursachen kann, aus der personal.xlsb gelesen und du kannst bestimmen, wie viele Berechnungen pro Monst und je Lauf maximal durchgeführt werden dürfen.
Bei den Adressen handelt es sich um Hagebau-Filialen, die im Internet frei verfügbar sind/waren.
Da diese Mappe für mich ein Vorbereitungsschritt für die Tourenplanung eines Außendienstmitarbeiters darstellt, ist in der Mappe auch ein Code enthalten, der alle von/an-Kombinationen generiert. Zu diesen werden dann die Distanzen ermittelt.
Den API-Key habe ich mir vor einigen Tagen auch freigeschaltet, um mit diesen auch die Geo-Codes der Adressen zu ermitteln. Da sich mit diesen, ohene weitere Internetabfrage die Luftlinien berechnen lassen.
Folgende(r) 1 Nutzer sagt Danke an ws-53 für diesen Beitrag:1 Nutzer sagt Danke an ws-53 für diesen Beitrag 28 • wisch