Webpage Scraping：UPS批量运单追踪VBA代码F8正常F5运行报错求助

这种分步执行（F8）正常、完整运行（F5）出错的场景，我见太多了，核心原因几乎都是代码执行速度与UPS页面加载速度不同步——单步调试时你手动给了页面充足的缓冲时间去渲染和加载追踪数据，但批量运行时，代码可能在页面还没准备好就急着读取元素，直接触发运行时错误。结合你要获取包裹留存日期及地点的需求，给你几个针对性的解决方案：

1. 添加智能元素等待机制 #

别用固定的Sleep或者只判断IE.ReadyState，这两种方式都不够可靠（有时候页面状态显示已完成，但实际追踪数据还在加载）。最好写一个自定义函数，等待目标元素完全加载出来再执行后续代码。

比如这个通用的等待函数：

Sub WaitForElement(IE As Object, ByVal method As String, ByVal selector As String)
    Dim element As Object
    Dim startTime As Date
    startTime = Now
    
    Do
        DoEvents
        On Error Resume Next
        Select Case LCase(method)
            Case "id"
                Set element = IE.Document.getElementById(selector)
            Case "css"
                Set element = IE.Document.querySelector(selector)
            Case "name"
                Set element = IE.Document.getElementsByName(selector)(0)
        End Select
        On Error GoTo 0
        
        ' 设置10秒超时，避免无限等待
        If Now > startTime + TimeValue("00:00:10") Then
            MsgBox "等待元素超时：" & selector
            Exit Sub
        End If
    Loop Until Not element Is Nothing
End Sub

2. 模拟人工操作的随机延迟 #

批量高频请求UPS网站很容易被识别为机器人，单步执行时间隔长没事，批量跑太快就会被拦截。在每次追踪请求后添加随机延迟，模拟人工操作的间隔：

' 生成2-5秒的随机等待
Application.Wait Now + TimeValue("00:00:" & CStr(Int((5 - 2 + 1) * Rnd + 2)))

3. 优化完整追踪流程的代码示例 #

结合上面两点，给你整理了适配需求的完整代码框架（注意：UPS的页面DOM结构可能会更新，需要你根据实际页面调整元素选择器）：

Sub TrackUPSPackages()
    Dim IE As Object
    Dim trackingNum As String
    Dim trackingNums As Variant
    Dim i As Integer
    
    ' 你的运单编号列表
    trackingNums = Array("1Z5X10F70364459911", "1Z5X10F79065556123", "1Z5X10F70364649537", _
                        "1Z5X10F79064044142", "1Z5X10F70365323958", "1Z5X10F79066952961", _
                        "1Z5X10F70364875177", "1Z5X10F79065114583")
    
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True ' 调试时保持可见，上线后可改为False
    
    For i = LBound(trackingNums) To UBound(trackingNums)
        trackingNum = trackingNums(i)
        
        ' 打开UPS追踪页面
        IE.Navigate "https://www.ups.com/track?loc=en_US&requester=ST/"
        
        ' 等待页面基础结构加载
        Do While IE.Busy Or IE.ReadyState <> 4
            DoEvents
        Loop
        
        ' 等待追踪输入框加载完成
        WaitForElement IE, "id", "stq"
        IE.Document.getElementById("stq").Value = trackingNum
        
        ' 提交查询
        WaitForElement IE, "id", "trackBtn"
        IE.Document.getElementById("trackBtn").Click
        
        ' 等待追踪结果容器加载（需根据UPS实际页面调整CSS选择器）
        WaitForElement IE, "css", ".ups-track-package-details"
        
        ' 抓取留存日期和地点（示例选择器，需验证后调整）
        Dim retentionDate As String, retentionLocation As String
        On Error Resume Next
        retentionDate = IE.Document.querySelector(".ups-date-display").innerText
        retentionLocation = IE.Document.querySelector(".ups-location-display").innerText
        On Error GoTo 0
        
        ' 将结果写入工作表（这里假设写入Sheet1的A、B、C列）
        Sheets("Sheet1").Cells(i + 1, 1).Value = trackingNum
        Sheets("Sheet1").Cells(i + 1, 2).Value = retentionDate
        Sheets("Sheet1").Cells(i + 1, 3).Value = retentionLocation
        
        ' 随机延迟，避免反爬拦截
        Application.Wait Now + TimeValue("00:00:" & CStr(Int((5 - 2 + 1) * Rnd + 2)))
    Next i
    
    IE.Quit
    Set IE = Nothing
    MsgBox "所有运单追踪完成！"
End Sub

额外注意事项 #

• DOM结构变化：UPS的页面可能会不定期更新，如果你发现代码突然失效，要重新检查元素的ID或CSS选择器是否变化；
• 反爬限制：如果还是频繁被拦截，可以尝试给IE设置自定义User-Agent，或者考虑使用UPS官方的追踪API（需要注册开发者账号，稳定性更高）；
• 错误处理：可以在代码中添加更多的On Error逻辑，比如某个运单查询失败时跳过并记录错误，避免整个批量任务中断。

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