Excel vba-谷歌地图超限查询

我正试图通过VBA从谷歌地图获取距离。这部分代码处于循环中，因此它在短时间内计算了相当多的距离，这就是为什么我尝试添加一种方法来处理随时间变化的查询。 我正在使用Desmond Oshiwambo的部分代码

Option Explicit

Const strUnits = "metric" ' imperial/metric (miles/km)
Const strTransportMode = "driving" ' alternative = 'walking'
Const strDelimeter = "|"    'for lists of via points
Const MAX_GOOGLE_RETRIES = 10

第一个函数是一个helper函数，它从googlemaps获取数据

Function gglDirectionsResponse(ByVal strStartLocation, ByVal strEndLocation, ByRef strTravelTime, ByRef strDistance, ByRef strInstructions, Optional ByRef strError = "") As Boolean
On Error GoTo ErrorHandler
Dim strURL As String
Dim objXMLHttp As Object
Dim objDOMDocument As Object
Dim nodeRoute As Object
Dim lngDistance As Long
Dim strThisLegDuration As String
Dim legRoute
Dim lngSeconds As Long

Set objXMLHttp = CreateObject("MSXML2.XMLHTTP")
Set objDOMDocument = CreateObject("MSXML2.DOMDocument.6.0")

strStartLocation = Replace(strStartLocation, " ", "+")
strEndLocation = Replace(strEndLocation, " ", "+")
strTravelTime = "00:00"
strURL = "http://maps.googleapis.com/maps/api/directions/xml" & _
        "?origin=" & strStartLocation & _
        "&destination=" & strEndLocation & _
        "&sensor=false" & _
        "&units=" & strUnits  
With objXMLHttp
    .Open "GET", strURL, False
    .setRequestHeader "Content-Type", "application/x-www-form-URLEncoded"
    .send
    objDOMDocument.LoadXML .responseText
End With

With objDOMDocument
    If .SelectSingleNode("//status").Text = "OK" Then

    'Iterate through each leg

        For Each legRoute In .SelectSingleNode("//route").ChildNodes
            If legRoute.BaseName = "leg" Then         'SelectSingleNode("/distance/value").Text
                  For Each nodeRoute In legRoute.ChildNodes
                    If nodeRoute.BaseName = "step" Then
                       lngDistance = lngDistance +     nodeRoute.SelectSingleNode("distance/value").Text    ' Retrieves distance in meters
                       lngSeconds = lngSeconds +     Val(nodeRoute.SelectSingleNode("duration/value").Text)
                    End If
                  Next
            End If
        Next

        strTravelTime = formatGoogleTime(lngSeconds)    ' Retrieves distance in meters


        Select Case strUnits
            Case "imperial": strDistance = Round(lngDistance * 0.00062137, 1)  'Convert meters to miles
            Case "metric": strDistance = Round(lngDistance / 1000, 1) 'Convert meters to miles
        End Select

    Else
        strError = .SelectSingleNode("//status").Text
        GoTo ErrorHandler
    End If
End With

gglDirectionsResponse = True
GoTo CleanExit

ErrorHandler:
    If strError = "" Then strError = Err.Description
    strDistance = -1
    strTravelTime = "00:00"
    strInstructions = ""
    gglDirectionsResponse = False

CleanExit:
    Set objDOMDocument = Nothing
    Set objXMLHttp = Nothing

End Function

第二个函数是我试图实现的“等待直到查询限制结束”。这不起作用，因为函数返回给我的值中有70%是-1（错误值）

函数getGoogleDistance（ByVal strFrom，ByVal strTo）作为字符串
作为字符串的Dim strDistance
作为字符串的Dim strTravelTime
Dim blnOverLimit作为布尔值
调暗lngStartTimer的长度
Dim lngQueryCount尽可能长
暗淡的lngQueryPauses尽可能长
作为字符串的模糊指令
朦胧如弦
暗灰色和长灰色一样
lngStartTimer=计时器
lngQueryCount=0
灰度=0
Application.DisplayStatusBar=True
如果是方向响应（strFrom、strTo、strTravelTime、strInstance、strInstructions、strError），则
做
blnOverLimit=False
如果（strInstance=“OVER\u QUERY\u LIMIT”），则
谷歌已经用完了，等几秒钟再试一次。
Application.StatusBar=“等待谷歌过载3秒”
应用程序。立即等待+时间值（“00:00:03”）'暂停2秒
Application.StatusBar=“重试”
lngQueryPauses=lngQueryPauses+1
blnOverLimit=True
lngreetries=lngreetries+1
其他的
如果（strError=”“）和（Val（strInstance）>0），则
Application.StatusBar=“已处理”
lngQueryCount=lngQueryCount+1
如果结束
如果结束
如果lngreetries>MAX\u GOOGLE\u重试，则
谷歌每日津贴已经达到
GoTo GoogleTooManyQueries
如果结束
循环直到Not blnOverLimit“超出限制”要么意味着查询太多太快，要么意味着已达到每日限额
如果（标准状态“无效请求”），则
getGoogleDistance=标准距离
如果结束
其他的
getGoogleDistance=-1
如果结束
清洁出口：
Application.StatusBar=“完成”
退出功能
GoogleTooManyQueries：
MsgBox“很抱歉，谷歌每天的查询限制已达到2000次。这可能需要24小时才能重置”，vbCritical
退出功能
错误处理程序：
MsgBox“错误：&错误说明，vbCritical
退出功能
端函数

---

如果有人能理解为什么代码没有被“减速”，我将不胜感激

我从这个链接输入了一个地址列表

在T430 Thinkpad上完成计算的时间约为60秒（这是一款非常古老的产品）

---

您是在问还是在问什么？是的，我试图通过在函数达到查询限制时停止函数来摆脱查询限制。我的尝试不起作用，因为它返回了一些有效距离，然后是一行“-1”，然后又返回了一些有效距离。我尝试了一下，也得到了“-1”。最后我做了一个循环，看看范围中是否还有“-1”，删除它们，然后重新开始。这很慢，但我最终得到了一些东西！

Function getGoogleDistance(ByVal strFrom, ByVal strTo) As String
Dim strDistance As String
Dim strTravelTime As String
Dim blnOverLimit As Boolean
Dim lngStartTimer As Long
Dim lngQueryCount As Long
Dim lngQueryPauses As Long
Dim strInstructions As String
Dim strError As String
Dim lngRetries As Long


lngStartTimer = Timer
lngQueryCount = 0
lngRetries = 0
Application.DisplayStatusBar = True
 If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then
 Do             
                blnOverLimit = False
                If (strDistance = "OVER_QUERY_LIMIT") Then
                ' Google has maxed out, wait a couple of seconds and try again.
                    Application.StatusBar = "Waiting 3 second for Google overload"
                    Application.Wait Now + TimeValue("00:00:03")  ' pause 2 seconds
                    Application.StatusBar = "Try again"

                    lngQueryPauses = lngQueryPauses + 1
                    blnOverLimit = True
                    lngRetries = lngRetries + 1
                Else
                    If (strError = "") And (Val(strDistance) > 0) Then
                        Application.StatusBar = "Processed "
                        lngQueryCount = lngQueryCount + 1
                    End If
                End If

                If lngRetries > MAX_GOOGLE_RETRIES Then
                    ' the Google per day allowance hase been reached
                GoTo GoogleTooManyQueries
                End If

            Loop Until Not blnOverLimit  ' Over Limit either means too many queries too fast, or that the per day allowance has been reached

            If (strDistance <> "INVALID_REQUEST") Then
                getGoogleDistance = strDistance

            End If

Else
    getGoogleDistance = -1
End If
CleanExit:
    Application.StatusBar = "Finished"
    Exit Function

GoogleTooManyQueries:
    MsgBox "Sorry, Google limit of 2000 queries per day has been reached. This may take upto 24 hours to reset", vbCritical
    Exit Function

ErrorHandler:
    MsgBox "Error :" & Err.Description, vbCritical
    Exit Function

End Function

'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?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)
    Exit Function
ErrorHandl:
    GetDistance = -1
End Function