VBA调用Twitter API获取帖子数据遇Error 429问题求助

我有一个用于监控社交媒体帖子、追踪各平台点赞、分享等数据的MS Access数据库，此前一直手动处理，耗时久、人力成本高，计划通过Twitter API实现自动化。在付费获取X/Twitter更高权限前，编写了一段VBA脚本：用户可在弹窗中粘贴帖子URL，脚本通过API获取帖子详情并返回结果至弹窗，后续将对接数据库自动提取URL、解析并更新记录。但脚本持续返回Error 429错误：

服务收到来自您的请求过多 [item 0]
Too Many Requests
错误代码：429
完整信息：
429 - "{"title":"Too Many Requests","detail":"Too Many Requests","type":"about:blank","status":429}"

登录X账号后显示“2 pulls of 100”，说明实际请求量远未超限，且我12小时才手动点击运行一次脚本，并未触发突发请求限制，求解决思路。

我的VBA代码 #

Sub GetTwitterPostMetrics()
    ' Twitter v2 API Bearer Token - Replace with your actual token
    Const BEARER_TOKEN As String = "HIDDEN FROM THE PUBLIC"
    
    ' Prompt user for Twitter post URL
    Dim postUrl As String
    postUrl = InputBox("Paste the Twitter post URL:", "Twitter Post URL")
    
    ' Check if user cancelled or entered empty string
    If postUrl = "" Then
        MsgBox "No URL provided. Operation cancelled.", vbInformation
        Exit Sub
    End If
    
    ' Extract post ID from URL
    Dim postId As String
    postId = ExtractPostId(postUrl)
    
    If postId = "" Then
        MsgBox "Invalid Twitter URL format. Please provide a valid Twitter post URL.", vbCritical
        Exit Sub
    End If
    
    ' Create HTTP request
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    ' API endpoint with metrics
    Dim apiUrl As String
    apiUrl = "https://api.twitter.com/2/tweets/" & postId & "?tweet.fields=public_metrics"
    
    ' Make the request
    On Error GoTo ErrorHandler
    http.Open "GET", apiUrl, False
    http.setRequestHeader "Authorization", "Bearer " & BEARER_TOKEN
    http.setRequestHeader "Content-Type", "application/json"
    http.send
    
    ' Check response status
    If http.Status = 200 Then
        ' Parse JSON response
        Dim jsonResponse As String
        jsonResponse = http.responseText
        
        ' Extract metrics from JSON
        Dim metrics As String
        metrics = ParseMetrics(jsonResponse)
        
        ' Display results
        MsgBox metrics, vbInformation, "Twitter Post Metrics"
    Else
        MsgBox "API request failed with status: " & http.Status & vbCrLf & _
               "Response: " & http.responseText, vbCritical, "API Error"
    End If
    
    Exit Sub
    
ErrorHandler:
    MsgBox "An error occurred: " & Err.Description, vbCritical, "Error"
End Sub

Function ExtractPostId(url As String) As String
    ' Extract post ID from various Twitter URL formats
    ' Examples:
    ' https://twitter.com/username/status/1234567890
    ' https://x.com/username/status/1234567890
    ' https://mobile.twitter.com/username/status/1234567890
    
    Dim postId As String
    Dim parts() As String
    
    ' Remove any query parameters
    If InStr(url, "?") > 0 Then
        url = Left(url, InStr(url, "?") - 1)
    End If
    
    ' Split URL by forward slashes
    parts = Split(url, "/")
    
    ' Look for "status" in the URL parts
    Dim i As Integer
    For i = 0 To UBound(parts)
        If LCase(parts(i)) = "status" Then
            If i < UBound(parts) Then
                postId = parts(i + 1)
                Exit For
            End If
        End If
    Next i
    
    ' Validate that we got a numeric ID
    If IsNumeric(postId) And Len(postId) > 10 Then
        ExtractPostId = postId
    Else
        ExtractPostId = ""
    End If
End Function

Function ParseMetrics(jsonText As String) As String
    ' Simple JSON parsing for metrics
    ' Note: This is a basic parser. For production use, consider a proper JSON library
    
    Dim result As String
    Dim retweets As Long, likes As Long, replies As Long, quotes As Long
    Dim impressions As Long, views As Long
    
    ' Extract metrics using string parsing
    retweets = ExtractMetricValue(jsonText, "retweet_count")
    likes = ExtractMetricValue(jsonText, "like_count")
    replies = ExtractMetricValue(jsonText, "reply_count")
    quotes = ExtractMetricValue(jsonText, "quote_count")
    
    ' Note: impressions and views require different API access levels
    ' They may not be available with basic API access
    
    ' Format results
    result = "Twitter Post Metrics:" & vbCrLf & vbCrLf
    result = result & "Likes: " & Format(likes, "#,##0") & vbCrLf
    result = result & "Retweets: " & Format(retweets, "#,##0") & vbCrLf
    result = result & "Replies: " & Format(replies, "#,##0") & vbCrLf
    result = result & "Quotes: " & Format(quotes, "#,##0") & vbCrLf
    
    ' Check if impressions data is available in response
    If InStr(jsonText, "impression_count") > 0 Then
        impressions = ExtractMetricValue(jsonText, "impression_count")
        result = result & "Impressions: " & Format(impressions, "#,##0") & vbCrLf
    End If
    
    ParseMetrics = result
End Function

Function ExtractMetricValue(jsonText As String, metricName As String) As Long
    ' Extract numeric value for a specific metric from JSON
    Dim startPos As Integer, endPos As Integer
    Dim searchString As String
    Dim valueString As String
    
    searchString = """" & metricName & """:" ' e.g., "like_count":
    startPos = InStr(jsonText, searchString)
    
    If startPos > 0 Then
        startPos = startPos + Len(searchString)
        ' Skip any whitespace
        While Mid(jsonText, startPos, 1) = " "
            startPos = startPos + 1
        Wend
        
        ' Find the end of the number (comma or closing brace)
        endPos = startPos
        While endPos <= Len(jsonText) And IsNumeric(Mid(jsonText, endPos, 1))
            endPos = endPos + 1
        Wend
        
        valueString = Mid(jsonText, startPos, endPos - startPos)
        If IsNumeric(valueString) Then
            ExtractMetricValue = CLng(valueString)
        End If
    End If
End Function

解决思路 #

• 核对Bearer Token的归属与权限：确认你使用的Bearer Token对应的API项目，和你查看请求量的X账号是否绑定。免费版API的请求限制是按项目计算，而非账号，如果这个项目下有其他应用或历史请求，可能已经耗尽额度。
• 移除多余的请求头：GET请求不需要Content-Type: application/json头，这行代码可能导致API判定请求异常，建议删除http.setRequestHeader "Content-Type", "application/json"。
• 排查IP限流：如果你的IP曾有过批量请求（哪怕不是用当前账号），可能被Twitter风控临时限制，尝试切换网络（比如手机热点）测试。
• 用第三方工具验证请求：在Postman或浏览器中，用相同的Bearer Token发送相同的API请求，确认是否能成功，排除VBA环境的问题。
• 添加带退避的重试逻辑：即使请求量未超限，临时网络波动或API限流也可能返回429，可添加简单重试：

  Dim retryCount As Integer
  retryCount = 0
  Do
      http.send
      If http.Status = 429 And retryCount < 2 Then
          retryCount = retryCount + 1
          Application.Wait Now + TimeValue("00:00:05")
      Else
          Exit Do
      End If
  Loop While http.Status = 429 And retryCount < 2
  

• 读取Retry-After头信息：429响应通常会返回Retry-After头，提示需要等待的秒数，可在错误处理中添加读取逻辑：

  ElseIf http.Status = 429 Then
      Dim retryAfter As String
      retryAfter = http.getResponseHeader("Retry-After")
      MsgBox "请求过多，请等待" & retryAfter & "秒后重试。" & vbCrLf & _
             "响应: " & http.responseText, vbCritical, "API错误"
  End If
  

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