Следующий код не находит расстояние между двумя ячейками в Excel VBA, используя Google API, чтобы найти расстояние - PullRequest
Новая
       21

Следующий код не находит расстояние между двумя ячейками в Excel VBA, используя Google API, чтобы найти расстояние

0 голосов
/ 14 октября 2019

Google API не работает, чтобы найти расстояние между источником и назначением в Excel VBA

Я пытался изменить API, но это не API, это код. 

Public Function GetDistance(start As String, dest As String)
    Dim firstVal As String, secondVal As String, lastVal As String
    firstVal = "http://maps.googleapis.com/maps/api/distancematrix/json?origins="
    secondVal = "&destinations="
    lastVal = "&mode=car&language=pl&sensor=false&key=MyKey"
    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

1 Ответ

0 голосов
/ 15 октября 2019

Поскольку вы возвращаете JSON, вы можете легче использовать JSON парсер для получения результатов.

Я использую 

' VBA-JSON v2.3.0
' (c) Tim Hall - https://github.com/VBA-tools/VBA-JSON
'
' JSON Converter for VBA

А вот код, который будетвернуть расстояние проезда между двумя точками: 

Option Explicit
Function getDistance(sStart As String, Dest As String)
    Const API As String = "key=myAPI"
    Const sURL1 As String = "https://maps.googleapis.com/maps/api/distancematrix/json?units=imperial"
    Dim sURL() As String
    Dim sOrigin As String, sDest As String
    Dim xhrRequest As XMLHTTP60

Dim strJSON As String, JSON As Object

sOrigin = Replace("origins=" & sStart, " ", "+")
sDest = Replace("destinations=" & Dest, " ", "+")

'Many ways to create the URL to send
ReDim sURL(3)
    sURL(0) = sURL1
    sURL(1) = sOrigin
    sURL(2) = sDest
    sURL(3) = API

Set xhrRequest = New XMLHTTP60
With xhrRequest
    .Open "Get", Join(sURL, "&"), False
    .sEnd
    strJSON = .responseText
End With

Set JSON = parsejson(strJSON)


'"text" returns a string in local language
'"value" returns the distance in meters
getDistance = JSON("rows")(1)("elements")(1)("distance")("text")

End Function

Существуют и другие варианты, и вы можете прочитать документацию по API, которая в настоящее время находится в Руководстве для разработчиков Матрицы расстояний Google

Если развернуть объект JSON в окне просмотра, вы сможете выяснить, как он создается для создания строки, возвращающей желаемое значение.

...