无需打开浏览器，用Excel VBA追踪MSC货运提单信息及报错解决

一、原代码错误原因 #

• 运行时错误424本质是找不到目标DOM对象：
  • 依赖硬延迟(delay函数)控制页面加载，时间不足会导致元素未渲染完成
  • IE对象的DOM定位依赖固定ID，MSC官网页面结构可能已更新，旧ID失效
  • 硬编码单个提单号，未适配Sheet1批量处理的需求

二、无浏览器实现方案（XMLHTTP+HTML解析） #

直接通过HTTP请求获取页面数据，无需启动浏览器，效率更高且稳定性更强。以下是适配Sheet1批量处理的完整代码：

Option Explicit

Sub BatchTrackMSC()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim blNumber As String
    Dim xmlHttp As Object
    Dim htmlDoc As Object
    Dim containerTables As Object, table As Object
    Dim rowNum As Long, colNum As Long
    Dim targetRow As Long
    
    ' 初始化工作表
    Set ws = ThisWorkbook.Sheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    targetRow = 2 ' 从B2开始写入数据，可按需调整
    
    ' 创建XMLHTTP与HTML解析对象
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
    Set htmlDoc = CreateObject("HTMLFile")
    
    ' 遍历A列所有提单号
    For i = 2 To lastRow ' 假设A1是表头，数据从A2开始
        blNumber = Trim(ws.Cells(i, "A").Value)
        If blNumber = "" Then GoTo NextBL
        
        ' 发送HTTP请求获取追踪页面
        On Error Resume Next
        xmlHttp.Open "GET", "https://www.msc.com/track-a-shipment?billOfLading=" & blNumber, False
        xmlHttp.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/114.0.0.0 Safari/537.36"
        xmlHttp.Send
        
        If xmlHttp.Status <> 200 Then
            ws.Cells(targetRow, "B").Value = "请求失败：" & xmlHttp.Status
            targetRow = targetRow + 1
            GoTo NextBL
        End If
        On Error GoTo 0
        
        ' 加载HTML文档用于解析
        htmlDoc.body.innerHTML = xmlHttp.responseText
        
        ' 定位集装箱数据表格
        Set containerTables = htmlDoc.getElementsByClassName("resultTable")
        If containerTables.Length = 0 Then
            ws.Cells(targetRow, "B").Value = "未找到集装箱数据"
            targetRow = targetRow + 1
            GoTo NextBL
        End If
        
        ' 遍历每个集装箱表格，写入Excel
        For Each table In containerTables
            For rowNum = 0 To table.Rows.Length - 1
                For colNum = 0 To table.Rows(rowNum).Cells.Length - 1
                    ws.Cells(targetRow, colNum + 2).Value = Trim(table.Rows(rowNum).Cells(colNum).innerText)
                Next colNum
                targetRow = targetRow + 1
            Next rowNum
            ' 集装箱数据间空行分隔
            targetRow = targetRow + 1
        Next table
        
NextBL:
    Next i
    
    ' 释放对象
    Set xmlHttp = Nothing
    Set htmlDoc = Nothing
    MsgBox "批量追踪完成！", vbInformation
End Sub

三、代码核心说明 #

• 无浏览器运行：使用MSXML2.XMLHTTP发送请求，直接获取页面源码，无需启动任何浏览器
• 批量处理：自动遍历Sheet1 A列所有提单号，从B列开始按顺序写入数据
• 容错机制：添加请求状态检查、数据不存在提示，避免程序崩溃
• 稳定定位：通过类名resultTable定位集装箱表格，比固定ID更适配官网结构更新

四、注意事项 #

• 需将Excel文件另存为.xlsm格式以启用宏
• 若遭遇官网反爬限制，可在NextBL标签前添加延迟函数（如Delay 2）
• 若官网页面结构更新，需调整元素定位的类名或逻辑

内容的提问来源于stack exchange，提问作者S. Shotez