VBA Excel Bing Maps API Distance Calculator

This little snippet will allow you to calculate distance in ‚km‘ from 2 adresses.
I know it’s not that pretty but pretty functional.

Copyright @schindler-it.org
If this code was usefull make a reference in your code to me 🙂

You need to replace YOUR_KEY with your Bing Maps api key.
If you wish to have your result in miles rather than using km replace that string.
(Use distanceUnit=miles).

For further changes of the request itself please check the microsoft support page.

Public Function GetDistance(start As String, dest As String)

'From schindler-it.org - please don't delete this reference :)

Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")

objHTTP.Open "GET", "http://dev.virtualearth.net/REST/v1/Locations?q=" & start & "&key=YOUR_KEY", False

objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"

objHTTP.send ("")

If InStr(objHTTP.responseText, "coordinates") = 0 Then GoTo ErrorHandl

Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = "(?=.*)\[([0-9]+.[0-9]+,[0-9]+.[0-9]+)\]": regex.Global = False

Set matches = regex.Execute(objHTTP.responseText)

coordinates1 = matches(0).SubMatches(0)

'MsgBox coordinates1

objHTTP.Open "GET", "http://dev.virtualearth.net/REST/v1/Locations?q=" & dest & "&key=YOUR_KEY", False

objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"

objHTTP.send ("")

If InStr(objHTTP.responseText, "coordinates") = 0 Then GoTo ErrorHandl

Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = "(?=.*)\[([0-9]+.[0-9]+,[0-9]+.[0-9]+)\]": regex.Global = False

Set matches = regex.Execute(objHTTP.responseText)

coordinates2 = matches(0).SubMatches(0)

'MsgBox coordinates2

objHTTP.Open "GET", "https://dev.virtualearth.net/REST/v1/Routes/DistanceMatrix?origins=" & coordinates1 & "&destinations=" & coordinates2 & "&travelMode=driving&distanceUnit=km&output=json&key=YOUR_KEY", False

'Sheets(1).Cells(1, 1).Value = "https://dev.virtualearth.net/REST/v1/Routes/DistanceMatrix?origins=" & coordinates1 & "&destinations=" & coordinates2 & "&travelMode=driving&distanceUnit=km&output=json&key=YOUR_KEY"

objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"

objHTTP.send ("")

If InStr(objHTTP.responseText, "travelDistance") = 0 Then GoTo ErrorHandl

Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = "([0-9]+\.[0-9]+)": regex.Global = True

Set matches = regex.Execute(objHTTP.responseText)

msg = ""

For Each t In matches

msg = msg & t & vbCrLf

Next

'MsgBox msg

GetDistance = matches(4)

Exit Function

ErrorHandl:

MsgBox "ERROR"

MsgBox (objHTTP.responseText)

GetDistance = -1

End Function