Ort zu Ort Entfernungen

Sub Entfernung_google()
'es werden immer nur die leeren Zellen abgefragt
Dim IEApp As Object
Dim IEDocument As Object
Set IEApp = CreateObject("InternetExplorer.Application")
IEApp.Visible = False
For i = 2 To Tabelle1.UsedRange.Columns.Count
If Tabelle1.Cells(1, i).Value = "" Then Exit For
For j = 2 To Tabelle1.UsedRange.Rows.Count
If Tabelle1.Cells(j, 1).Value = "" Then Exit For
If Tabelle1.Cells(j, i).Value = "" Then
If Tabelle1.Cells(1, i).Value  Tabelle1.Cells(j, 1).Value Then
IEApp.Navigate "http://maps.google.de/maps?saddr=" & Tabelle1.Cells(1, i).Value & _
"&daddr=" & Tabelle1.Cells(j, 1).Value & "&output=html"
Application.StatusBar = "Start-> " & Tabelle1.Cells(1, i).Value & _
" Ziel-> " & Tabelle1.Cells(j, 1).Value
Do: Loop Until IEApp.Busy = False
Do: Loop Until IEApp.Busy = False
Set IEDocument = IEApp.Document
Do: Loop Until IEDocument.ReadyState = "complete"
Set result = IEDocument.getElementById("dditd")
If Not result Is Nothing Then
teile = Split(result.innerText, "–")
Tabelle1.Cells(j, i).Value = Replace(teile(0), "km", "")
End If
Set IEDocument = Nothing
End If
End If
Next
Next
IEApp.Quit
Set IEApp = Nothing
Application.StatusBar = False
MsgBox "Fertig"
End Sub