Google Api в Excel для расчета расстояния проезда между местами

Question

У меня есть около 20 K пар для расчета расстояния между ними. Я использую следующий скрипт VB -

'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 = "http://maps.googleapis.com/maps/api/distancematrix/json?units=metric&origins="
    secondVal = "&destinations="
    lastVal = "&mode=car&language=en&sensor=false&key=A***Bh*Eh-g***LvJ7bRirvjlr****OkUvs"
    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

Когда я пишу =GetDistance("Atlanta", "Miami"), он выдает -1 (ошибка). Однако, когда я вставляю URL в браузер, он работает.

Answer 1

В вашем коде вы используете http, где API сейчас принимает только https, все, что вам нужно сделать, это заменить http на https

firstVal = "https://maps.googleapis.com/maps/api/distancematrix/json?origins="

Answer 2

У меня такая же ошибка, но я нашел другой способ (вам нужно активировать ссылку Microsoft XML, v6.0 ):

Function G_DISTANCE(Origin As String, Destination As String) As Double
' Requires a reference to Microsoft XML, v6.0

Dim myRequest As XMLHTTP60
Dim myDomDoc As DOMDocument60
Dim distanceNode As IXMLDOMNode
    G_DISTANCE = 0
    ' Check and clean inputs
    On Error GoTo exitRoute
    Origin = WorksheetFunction.EncodeURL(Origin)
    Destination = WorksheetFunction.EncodeURL(Destination)
    ' Read the XML data from the Google Maps API
    Set myRequest = New XMLHTTP60
    myRequest.Open "GET", "http://maps.googleapis.com/maps/api/directions/xml?origin=" _
        & Origin & "&destination=" & Destination & "&sensor=false", False
    myRequest.send
    ' Make the XML readable usign XPath
    Set myDomDoc = New DOMDocument60
    myDomDoc.LoadXML myRequest.responseText
    ' Get the distance node value
    Set distanceNode = myDomDoc.SelectSingleNode("//leg/distance/value")
    If Not distanceNode Is Nothing Then G_DISTANCE = distanceNode.Text / 1000
exitRoute:
    ' Tidy up
    Set distanceNode = Nothing
    Set myDomDoc = Nothing
    Set myRequest = Nothing
End Function

источник: http://oco -carbon.com / coding / distance-function-google-excel /

Результат с вашим кодом:

Результат со второй функцией: