Excel中的Google Api计算地点之间的行驶距离

时间:2018-07-05 06:45:19

标签: excel-vba google-maps-api-3 vba excel

我大约有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粘贴到浏览器中时,它可以工作。

2 个答案:

答案 0 :(得分: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/

结果与您的代码: enter image description here

具有第二个功能的结果: enter image description here

答案 1 :(得分:0)

在您的代码中,您使用的是http,而API现在仅接受HTTPS,您所需要做的就是将HTTP替换为https

/movies/categories/${category_name}