Hallo,
habe vor paar Jahren schon zu dem Thema geschrieben.
https://www.clever-excel-forum.de/Thread...en?page=14
https://www.clever-excel-forum.de/Thread...it-API-Key
Wirklich zum Laufen habe ich das Ganze nicht bekommen.
Würde mich jetzt nochmal melden, um das hinzubekommen, da es momentan wieder aktuell ist.
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.
Gruß
Tobias
Hallo Tobias,
das Thema ist zwischenzeitlich schon wieder x-mal in den diversen Form diskutiert worden.
Hier zwei Beispiele:
Excel2010 - Entfernung berechnen - MS-Office-Forum (s. ab Seite 4)
Excel2019 - Entfernung in Km mit google maps ermitteln - MS-Office-Forum
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 ExplicitPrivate 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 StringEnd TypeSub 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 SubSub 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 WithEnd Sub
_________
viele Grüße
Karl-Heinz
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.