ich habe folgenden Code für die Distanzberechnung gefunden und für meine Zwecke angepasst.
Manchmal funktioniert er und manchmal nicht und ich weiß einfach nicht warum.
Die Fehlermeldung lautet:
Objektvariable oder With-Blockvariable nicht festgelegt (wo der Fehler kommt habe ich im Code hingeschrieben)
Kann bitte mal jemand drüberschauen und helfen
Vielen Dank
Public Sub Entfernung()
'Variablendeklarationen
'Objekt - Late Binding
Dim objXML As Object 'fuer XML-"String"
Dim xmlDoc As Object
Dim xmlNod As Object
Dim wks_Tab As Worksheet
Dim wks_?bersicht As Worksheet
Dim lzTab As Long
Dim i As Long
'Objekt - Early Binding
'Dim xmlDoc As New MSXML2.DOMDocument
'Dim xmlNod As MSXML2.IXMLDOMNode
'String
Dim strOAddr$, strDAddr
'Integer
'On Error GoTo errorhandler
'Flackern aus
Application.ScreenUpdating = False
'XML-Objecte instanzieren
Set objXML = CreateObject("Msxml2.XMLHTTP")
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
Set wks_Tab = ThisWorkbook.Worksheets("Tabelle2")
Set wks_?bersicht = ThisWorkbook.Worksheets("?BERSICHT")
lzTab = wks_Tab.Cells(Rows.Count, 1).End(xlUp).Row
'Wenn Instanzierung nicht nichts gebracht hat, dann
If Not objXML Is Nothing Then
'OriginAddress ermitteln
'Hinweise:
'PLZ auch 4stellig moeglich
strOAddr = Format(wks_?bersicht.Cells(3, 2), "0####") & "," & ReplaceGermans(wks_? _
bersicht.Cells(4, 2))
'Schleife ueber alle DestinationAddress
For i = 1 To lzTab
'DestinationAddress ermitteln
'Hinweise:
'PLZ nicht 4stellig moeglich!
strDAddr = Format(wks_Tab.Cells(i, 1), "0####") & "," & ReplaceGermans(wks_Tab.Cells(i, _
2))
'Abfrage oeffnen
objXML.Open "POST", "http://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & _
strOAddr & ",germany&&destinations=" & strDAddr & ",germany&&language=de-DE&sensor=false", False
'Abfrageheader
objXML.setRequestHeader "Content-Type", "content=text/html; charset=UTF-8"
'Abfrage senden
objXML.send
'Abfrageergebnis (Text) aufnehmen
xmlDoc.LoadXML objXML.responseText
'Zeit auslesen /Value=Sekunden /Text = Minuten mit Angabe "Minuten"
Set xmlNod = xmlDoc.SelectSingleNode("//row/element/duration/value")
'Zeit in Stundenzelle eintragen, Rueckgabewert / 86400
wks_Tab.Cells(i, 3) = CDate(xmlNod.Text / 86400) 'Hier kommt der Fehler
'Entfernung auslesen /Value=Meter /Text = Kilometer mit Angabe "km"
Set xmlNod = xmlDoc.SelectSingleNode("//row/element/distance/value")
'Entfernung in km zelle eintragen, Rueckgabewert / 1000
Cells(i, 4) = CDbl(xmlNod.Text / 1000) 'Hier kommt der Fehler
Next i
'Ende Wenn Instanzierung nicht nichts gebracht hat, dann
End If
'Fehlerbehandlung / Programmende
errorhandler:
'Flackern ein
Application.ScreenUpdating = True
'Wenn Fehlernummer 0, dann Ausgabe Fehlermeldung
'If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description
'XML-Objecte zuruecksetzen
Set xmlNod = Nothing
Set xmlDoc = Nothing
Set objXML = Nothing
End Sub