Excel VBA调用谷歌地图查询超限的解决方案咨询

我经常帮开发者解决这类批量调用API的频次限制问题，结合你给出的常量和循环批量查询的场景，咱们可以从错误捕获、指数退避重试、循环限流这几个方面来调整代码，完美应对谷歌地图的查询超限问题。

首先先把你给出的常量放在代码块里，方便后续引用：

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

核心处理方案 #

• 捕获超限错误标识：谷歌地图API返回超限的时候，通常会在响应里包含"status": "OVER_QUERY_LIMIT"，或者返回HTTP 429状态码。我们需要在请求函数里解析这个响应，判断是否触发了限制。
• 指数退避重试机制：利用你定义的MAX_GOOGLE_RETRIES常量，每次重试前逐步增加等待时间（比如第一次等1秒，第二次2秒，第四次4秒……），给谷歌的API服务器足够的冷却时间，避免一直触发限制。
• 循环基础延迟：在批量循环的每一次请求后，添加一个基础的短延迟（比如500毫秒），从源头降低请求密度，减少触发超限的概率。

示例修改后的查询函数 #

下面是整合了这些处理逻辑的示例函数（假设你的原函数是GetGoogleDistance）：

Function GetGoogleDistance(strOrigin As String, strDestination As String) As Double
    Dim xmlHttp As Object
    Dim strUrl As String
    Dim jsonResponse As String
    Dim retryCount As Integer
    Dim waitTime As Long
    
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
    retryCount = 0
    waitTime = 1000 ' 初始等待时间1秒
    
    Do While retryCount < MAX_GOOGLE_RETRIES
        On Error Resume Next
        strUrl = "https://maps.googleapis.com/maps/api/distancematrix/json?" & _
                 "origins=" & URLEncode(strOrigin) & _
                 "&destinations=" & URLEncode(strDestination) & _
                 "&mode=" & strTransportMode & _
                 "&units=" & strUnits & _
                 "&key=YOUR_API_KEY" ' 记得替换成你的API密钥
        
        xmlHttp.Open "GET", strUrl, False
        xmlHttp.Send
        
        ' 检查是否成功获取响应
        If xmlHttp.Status = 200 Then
            jsonResponse = xmlHttp.ResponseText
            ' 判断是否触发超限
            If InStr(jsonResponse, """status"": ""OVER_QUERY_LIMIT""") > 0 Then
                ' 触发超限，等待后重试
                retryCount = retryCount + 1
                Wait waitTime ' 自定义等待函数
                waitTime = waitTime * 2 ' 指数增加等待时间
            Else
                ' 解析距离数据（这里根据你的原解析逻辑调整）
                ' 示例解析：假设提取distance.value的数值
                Dim distanceStart As Integer, distanceEnd As Integer
                distanceStart = InStr(jsonResponse, """value"": ") + Len("""value"": ")
                distanceEnd = InStr(distanceStart, jsonResponse, ",")
                GetGoogleDistance = CDbl(Mid(jsonResponse, distanceStart, distanceEnd - distanceStart))
                Exit Do ' 成功获取数据，退出循环
            End If
        Else
            ' 其他HTTP错误，比如网络问题，同样重试
            retryCount = retryCount + 1
            Wait waitTime
            waitTime = waitTime * 2
        End If
        On Error GoTo 0
    Loop
    
    ' 如果重试次数用完还是失败，返回-1作为错误标识
    If retryCount >= MAX_GOOGLE_RETRIES Then
        GetGoogleDistance = -1
    End If
    
    Set xmlHttp = Nothing
End Function

' 自定义等待函数，单位毫秒
Sub Wait(milliseconds As Long)
    Dim start As Double
    start = Timer
    Do While Timer < start + milliseconds / 1000
        DoEvents ' 避免程序假死
    Loop
End Sub

' URL编码函数，处理地址中的特殊字符
Function URLEncode(strText As String) As String
    Dim strChar As String
    Dim i As Integer
    For i = 1 To Len(strText)
        strChar = Mid(strText, i, 1)
        Select Case strChar
            Case "A" To "Z", "a" To "z", "0" To "9", "-", "_", ".", "~"
                URLEncode = URLEncode & strChar
            Case " "
                URLEncode = URLEncode & "+"
            Case Else
                URLEncode = URLEncode & "%" & Hex(Asc(strChar))
        End Select
    Next i
End Function

循环中的额外优化 #

在你的批量循环代码里，每次调用GetGoogleDistance后，添加一个基础延迟，进一步降低请求频率：

' 示例循环代码
Sub BatchGetDistances()
    Dim i As Integer
    Dim lastRow As Integer
    lastRow = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To lastRow
        ' 获取距离
        Sheets("Data").Cells(i, "C").Value = GetGoogleDistance(Sheets("Data").Cells(i, "A").Value, Sheets("Data").Cells(i, "B").Value)
        ' 基础延迟500毫秒，根据实际情况调整
        Wait 500
    Next i
End Sub

这样调整后，你的代码就能智能处理谷歌地图的查询频次限制，既不会轻易触发超限，又能在触发后自动重试，保证批量数据的获取成功率。

内容的提问来源于stack exchange，提问作者Doule