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