VBA抓取AfterShip网页运单状态写入Excel 报424缺少对象错误求助

需求与初始代码说明 #

• 核心需求：从AfterShip物流追踪页提取Safexpress快件的派送状态，目标URL格式为https://www.aftership.com/track/safexpress/[运单号]，需要提取的目标文本格式为MM/DD/YYYY HH:MM DELIVERED这类带时间戳的状态值，最终写入Excel单元格，后续需要支持批量运单查询。
• 目标文本对应的DOM结构如下：

<div class="flex flex-col justify-center" style="width: calc(100% - 500px);">
<div style="max-width: 100%;width: 315px; overflow : hidden;text-overflow: ellipsis;display: -webkit-box;-webkit-line-clamp: 2;-webkit-box-orient: vertical;">
<div slot="information">
<div>04/06/2022 00:00 DELIVERED</div>
</div>
</div>
</div>

• 初始编写的VBA代码运行时触发错误"424" Object required（缺少对象）报错，初始代码如下：

Sub get_text_from_web()
  Dim html As Object
  Dim website As String
  
  website = "https://www.aftership.com/track/safexpress/107081775"
  Set html = CreateObject("htmlFile")
  With CreateObject("MSXML2.ServerXMLHTTP.6.0")
    .Open "GET", website, False
    .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:91.0) Gecko/20100101 Firefox/91.0"
    .Send
    
    If .Status = 200 Then
      html.body.innerHTML = .responseText
      Range("A1").Value = html.getElementsByClassName("flex flex-col justify-center")(0).innerText
    Else
      MsgBox "Page not loaded. HTTP status " & .Status
    End If
  End With
End Sub

问题核心原因 #

424缺少对象报错由两个问题直接导致：

• MSXML2.ServerXMLHTTP发起请求拿到的是页面初始静态源码，AfterShip的物流状态是页面加载完成后通过JS异步拉取渲染的，初始响应内容里不存在你在开发者工具看到的DOM节点，调用元素属性时自然找不到对象。
• 旧版htmlFile（IE内核DOM解析器）对带空格的多类名（比如你写的flex flex-col justify-center是三个class名组合）选择支持极差，就算节点存在也大概率匹配失败。

修正后可直接使用的代码 #

放弃DOM解析方案，直接用正则匹配固定格式的状态文本，兼容性更好，也适配后续批量查询需求：

Sub 批量查询Safexpress物流状态()
    Dim http As Object, reg As Object, matches As Object
    Dim lastRow As Long, i As Long
    Dim trackNum As String, queryUrl As String, respContent As String
    Dim deliveryStatus As String
    
    ' 初始化请求和正则匹配对象
    Set http = CreateObject("MSXML2.XMLHTTP.6.0")
    Set reg = CreateObject("VBScript.RegExp")
    reg.Global = True
    reg.IgnoreCase = True
    
    ' 表格配置：默认A列从A2开始存储运单号，B列输出状态，可按需修改列号
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRow
        trackNum = Trim(Cells(i, "A").Value)
        If trackNum <> "" Then
            queryUrl = "https://www.aftership.com/track/safexpress/" & trackNum
            ' 错误捕获避免个别请求失败中断整个批量任务
            On Error Resume Next
            http.Open "GET", queryUrl, False
            http.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/120.0.0.0 Safari/537.36"
            http.Send
            
            If http.Status = 200 Then
                respContent = http.responseText
                ' 正则匹配「MM/DD/YYYY HH:MM 状态大写文本」格式的目标内容
                reg.Pattern = "\d{2}/\d{2}/\d{4}\s\d{2}:\d{2}\s[A-Z]+"
                If reg.Test(respContent) Then
                    Set matches = reg.Execute(respContent)
                    deliveryStatus = matches(0).Value
                    Cells(i, "B").Value = deliveryStatus
                Else
                    Cells(i, "B").Value = "未获取到有效派送状态"
                End If
            Else
                Cells(i, "B").Value = "请求失败，HTTP状态码：" & http.Status
            End If
            On Error GoTo 0
            ' 加1秒请求间隔，避免访问频率过高被网站拦截
            Application.Wait Now + TimeValue("00:00:01")
        End If
    Next i
    
    ' 释放对象内存
    Set http = Nothing
    Set reg = Nothing
    Set matches = Nothing
    MsgBox "所有运单查询完成！"
End Sub

使用说明 #

• 如果只需要查询单个运单，删除循环逻辑，直接给trackNum赋值对应运单号，将结果输出到指定单元格（比如Range("A1").Value = deliveryStatus）即可。
• 如果你的运单存储列、结果输出列和代码默认配置不一致，直接修改代码里对应的列标字母即可。
• 如果运行时提示正则相关错误，打开VBA编辑器→工具→引用，找到「Microsoft VBScript Regular Expressions 5.5」勾选后再运行即可。

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