Getting Distances and DriveTimes

[Kyle123]

Getting driving distances and drive times seems to be a very popular topic recently. I had originally posted a thread as to how to get this via the google API which is extremely simple, grabbing this and putting it into excel directly however breaches the terms of use.

Since then, I have discovered that Microsoft also offers a similar API, you do however need to sign up and get a key (here) and accept their terms of use.

I don't think posting the below contravenes anything, but if anyone feels otherwise let me know and I'll happily remove this.

In the below, you need to input your API key in the relevant place.

Function GetDistance(sPCode As String, ePcode As String) As Double

    Dim t As String
    Dim re As Object
    
    
    t = "http://dev.virtualearth.net/REST/V1/Routes/Driving?o=xml&wp.0=" & sPCode & "&wp.1=" & ePcode & "&avoid=minimizeTolls&du=mi&key=YOUR_MS_KEY"
    Set re = CreateObject("msxml2.xmlhttp")
    
    re.Open "get", t, False
    re.send
    Do
        DoEvents
    Loop Until re.readyState = 4
    
    With re
        s = Split(.responseText, "<TravelDistance>")
    End With
    
    GetDistance = Val(s(1))

End Function

Function GetTimeinMins(sPCode As String, ePcode As String) As Double

    Dim t As String
    Dim re As Object
    
    t = "http://dev.virtualearth.net/REST/V1/Routes/Driving?o=xml&wp.0=" & sPCode & "&wp.1=" & ePcode & "&avoid=minimizeTolls&du=mi&key=YOUR_MS_KEY"
    
    Set re = CreateObject("msxml2.xmlhttp")
    re.Open "get", t, False
    re.send
    Do
        DoEvents
    Loop Until re.readyState = 4
    
    With re
        s = Split(.responseText, "<TravelDuration>")
    End With
    
    GetTimeinMins = Val(s(1)) / 60

End Function