Function Mobiliteit(o1, n1)
    On Error GoTo Fout
    Dim str1, str2, str3
    With New MSXML2.XMLHTTP
        str1 = o1 ' & "+" & o2 & "+" & o3
        str2 = n1 ' & "+" & n2 & "+" & n3
        .Open "Get", "http://maps.google.be/maps?f=d&source=s_d&saddr=" & str1 & "&daddr=" & str2
        .send
        Do
            DoEvents
        Loop Until .readyState = 4
        str3 = Mid(.responseText, InStr(.responseText, ",distance:") + 11, (InStr(.responseText, ",time:") - 3) - (InStr(.responseText, ",distance:") + 11)) * 1000
        If InStr((InStr(.responseText, "distance:")) * 1, .responseText, " km") = 0 Then
            str3 = Mid(.responseText, InStr(.responseText, ",distance:") + 11, (InStr(.responseText, ",time:") - 3) - (InStr(.responseText, ",distance:") + 11)) ' / 10
        End If
        Mobiliteit = (str3) & " meters"
        .abort
  End With

Exit Function
Fout:
    MsgBox "Kijk adres na "
    Mobiliteit = ""
End Function

Option Explicit

Private Sub CommandButton1_Click()
    'http://code.google.com/intl/nl/apis/maps/documentation/directions/
    'http://www.w3schools.com/dom/default.asp
    Dim avntField As Variant
    Dim iavntField As Long
    Dim lngColumn As Long
    Dim lngLength As Long
    Dim lngRow As Long
    Dim lngRows As Long
    Dim objHTTP As Object
    Dim objRouteLegFirst As Object
    Dim objXML As Object
    Dim strDestination As String
    Dim strField As String
    Dim strOrigin As String
    Dim strStatus As String
    Dim strURL As String
        avntField = Array("start_address", "", "start_location", "lat", "start_location", "lng", "end_address", "", "end_location", "lat", "end_location", "lng", "duration", "", "distance", "")
        Set objHTTP = CreateObject("MSXML2.XMLHTTP")
        Set objXML = CreateObject("MSXML2.DOMDocument")
        With Worksheets(1)
            lngRows = .Range("D" & .Rows.Count).End(xlUp).Row
            If lngRows >= 6 Then
                .Range("D6:K" & lngRows).ClearContents 'wissen
            End If
            lngRows = .Range("A" & .Rows.Count).End(xlUp).Row
            If lngRows >= 6 Then
                For lngRow = 6 To lngRows 'doorloop routes
                    lngColumn = 3 'am2011
                    strOrigin = .Range("A" & lngRow).Value
                    strDestination = .Range("B" & lngRow).Value
                    strURL = "http://maps.googleapis.com/maps/api/directions/xml?origin=" & strOrigin & "&destination=" & strDestination & "&alternatives=false&units=metric&sensor=false"
                    With objHTTP
                        .Open "GET", strURL, False
                        .Send 'routes ophalen en opslaan
                        Do
                            DoEvents
                        Loop Until .readyState = 4
                        Sleep 200
                        If .Status = 200 Then 'foutloos?
                            objXML.Load .responsexml 'routes opslaan
    '                        Open "test.txt" For Output As #1: Print #1, .responsetext: Close #1
                        Else
                            GoTo RouteNext 'fout!
                        End If
                    End With
                    With objXML
                        strStatus = .getElementsByTagName("status")(0).ChildNodes(0).NodetypedValue
                        If strStatus <> "OK" Then 'fout?
                            Worksheets(1).Range("D" & lngRow).Resize(1, 8).Value = "ERROR" 'error
                            GoTo RouteNext 'fout!
                        End If
                        Set objRouteLegFirst = .getElementsByTagName("route")(0).getElementsByTagName("leg")(0) 'eerste route
                    End With
                    With objRouteLegFirst
                        For iavntField = 0 To UBound(avntField) Step 2 'doorloop fields
                            lngLength = .getElementsByTagName(avntField(iavntField)).Length - 1 'vind index laatste element = totalen
                            If avntField(iavntField + 1) <> vbNullString Then 'lat/lng?
                                strField = .getElementsByTagName(avntField(iavntField + 0))(lngLength).getElementsByTagName(avntField(iavntField + 1))(0).ChildNodes(0).NodetypedValue 'ja
                            Else
                                strField = .getElementsByTagName(avntField(iavntField))(lngLength).ChildNodes(0).NodetypedValue 'nee
                            End If
                            lngColumn = lngColumn + 1 'volgende kolom
                            Worksheets(1).Cells(lngRow, lngColumn).Value = strField 'schrijven
                        Next
                    End With
RouteNext:
                Next
            End If
            .Columns("A:K").AutoFit 'autofit
        End With
        Set objHTTP = Nothing
        Set objXML = Nothing
        Set objRouteLegFirst = Nothing
End Sub