|
Hallo Zusammen,
ich habe zur Berechnung der Entferung zwischen zwei Orten das folgende Makro erstellt: Es ruft die Ausgangsadresse in Zelle A3 und die Endadresse in Zelle A5 ab und gibt anschließend die Entfernung in Zelle C5, sowie die Fahrtdauer in Zelle D5 aus. Leider lässt es sich nicht immer einwandfrei starten. Weiß jemand woran das vielleicht liegen könnte?
Public Sub Entferung()
Sheets("Tabelle1").Select
Dim objXML As Object
Dim xmlDoc As Object
Dim xmlNod As Object
Dim strOAddr$, strDAddr
On Error GoTo errorhandler
Set objXML = CreateObject("Msxml2.XMLHTTP")
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
If Not objXML Is Nothing Then
strOAddr = Cells(3, 1)
strDAddr = Cells(5, 1)
objXML.Open "POST", "http://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & strOAddr & "&destinations=" & strDAddr & "&language=de-DE", False
objXML.setRequestHeader "Content-Type", "content=text/html; charset=UTF-8"
objXML.send
xmlDoc.LoadXML objXML.responseText
Set xmlNod = xmlDoc.SelectSingleNode("//row/element/duration/value")
Cells(5, 4) = CDate(xmlNod.Text / 86400)
Set xmlNod = xmlDoc.SelectSingleNode("//row/element/distance/value")
Cells(5, 3) = xmlNod.Text / 1000
End If
errorhandler:
If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description
Set xmlNod = Nothing
Set xmlDoc = Nothing
Set objXML = Nothing
End Sub
|