|
Wenn ichs recht bedenke: 700 mal ein neues Objekt zu kreieren ist vielleicht doch etwas doof: Machs lieber so:
Sub Entfernung()
Dim o As Object
Dim r As String, Distanz As String, Zeit As String
Dim p1 As Long, p2 As Long
Dim Link As String
Link = "https://maps.googleapis.com/maps/api/directions/json?"
Set o = CreateObject("WinHttp.WinHttpRequest.5.1")
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
Application.Wait Now + TimeValue("0:00:01")
With o
.Open "GET", Link & "origin=" & Range("A" & i) & "&destination=" & Range("B" & i), False
.send
r = .responsetext
End With
p1 = InStr(1, r, "distance")
If p1 > 0 Then p1 = InStr(p1, r, "text")
If p1 > 0 Then p2 = InStr(p1, r, ",")
If p1 > 0 And p2 > 0 Then
Distanz = Mid(r, p1 + 9, p2 - p1 - 10)
Range("C" & i) = Distanz
End If
If p1 > 0 Then p1 = InStr(1, r, "duration")
If p1 > 0 Then p1 = InStr(p1, r, "text")
If p1 > 0 Then p2 = InStr(p1, r, ",")
If p1 > 0 And p2 > 0 Then
Zeit = Mid(r, p1 + 9, p2 - p1 - 10)
Range("D" & i) = Zeit
End If
Next i
End Sub
Und wie gesagt: Die Inputwerte in Spalte A bzw. B jeweils aus PLZ Leerzeichen und Ort bestehen.
Gruß Mr. K.
|