'A2 = "10 Downing Street, London, SW1A 2AA,United Kingdom"
'B2 = "Countryland, XY14 2LG, United Kingdom"
'C3 = GetDistance(A2, B2) / 1000 '580 in Kilometers
'https://analystcave.com/excel-calculate-distances-between-addresses/
'Returns distance in meters. Divide by 1000 to get kilometers.
'http://www.excelforum.com/showthread.php?t=1140863
Public Function GetDistance(start As String, dest As String)
Dim firstVal As String, secondVal As String, lastVal As String
Dim objHTTP As Object, URL As String, RegEx As Object
Dim matches As Object, tmpVal As String
firstVal = "http://maps.googleapis.com/maps/api/distancematrix/json?origins="
secondVal = "&destinations="
lastVal = "&mode=car&language=pl&sensor=false"
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URL = firstVal & Replace(start, " ", "+") & secondVal & Replace(dest, " ", "+") & lastVal
objHTTP.Open "GET", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.send ("")
If InStr(objHTTP.responseText, """distance"" : {") = 0 Then GoTo ErrorHandl
Set RegEx = CreateObject("VBScript.RegExp"): RegEx.Pattern = """value"".*?([0-9]+)": RegEx.Global = False
Set matches = RegEx.Execute(objHTTP.responseText)
tmpVal = Replace(matches(0).SubMatches(0), ".", Application.International(xlListSeparator))
GetDistance = CDbl(tmpVal) 'meters
Exit Function
ErrorHandl:
GetDistance = -1
End Function
Public Function MultiGetDistance(ParamArray args() As Variant) As Double
MultiGetDistance = 0
Dim startLoc As String, endLoc As String, i As Long
For i = LBound(args) To UBound(args) - 1
startLoc = args(i): endLoc = args(i + 1)
MultiGetDistance = MultiGetDistance + GetDistance(startLoc, endLoc)
Next i
End Function