'Calculate Google Maps distance between two addresses Public Function GetDistance(start As String, dest As String) Dim firstVal As String, secondVal As String, lastVal As String firstVal = "https://maps.googleapis.com/maps/api/distancematrix/json?units=metric&origins=" secondVal = "&destinations=" lastVal = "&mode=car&language=en&sensor=false&key=XXXXXX" 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) Exit Function ErrorHandl: GetDistance = -1 End Function
[/vba]
пару дней наза преестал возвращать расстояние хотя по запросу апи выдает все как и раньше
'Calculate Google Maps distance between two addresses Public Function GetDistance(start As String, dest As String) Dim firstVal As String, secondVal As String, lastVal As String firstVal = "https://maps.googleapis.com/maps/api/distancematrix/json?units=metric&origins=" secondVal = "&destinations=" lastVal = "&mode=car&language=en&sensor=false&key=XXXXXX" 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) Exit Function ErrorHandl: GetDistance = -1 End Function
[/vba]
пару дней наза преестал возвращать расстояние хотя по запросу апи выдает все как и раньше