如何用VBA实现Excel工作表物流单号与Purolator查询链接自动绑定？

完整可用VBA代码 #

这里提供两种实现方案，你可以根据自己的使用场景选择：

方案1：轻量化直接构造链接（推荐） #

无需调用浏览器，利用Purolator固定的查询链接规则直接生成超链接，几秒就能处理上百条单号，稳定性最高。

Sub BatchAddPurolatorTrackingLink()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim trackingNo As String
    Const baseUrl As String = "https://www.purolator.com/en/shipping/tracker?pins="
    
    ' 修改为你实际的工作表名称
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' 物流单号所在列的序号，A列对应1、B列对应2，以此类推
    Const trackingCol As Long = 1
    ' 查找单号列最后一条有内容的行号
    lastRow = ws.Cells(ws.Rows.Count, trackingCol).End(xlUp).Row
    
    ' 循环处理所有单号，假设第1行是表头，从第2行开始处理
    For i = 2 To lastRow
        trackingNo = Trim(ws.Cells(i, trackingCol).Value)
        If Len(trackingNo) > 0 Then
            ' 给当前单元格插入超链接，显示内容保留原有单号
            ws.Hyperlinks.Add _
                Anchor:=ws.Cells(i, trackingCol), _
                Address:=baseUrl & trackingNo, _
                TextToDisplay:=trackingNo
        End If
    Next i
    
    MsgBox "超链接批量生成完成，共处理" & lastRow - 1 & "条单号"
End Sub

使用说明：

• 如果你没有表头，把For i = 2 To lastRow里的2改成1即可
• 如果后续要适配其他快递，只需要修改baseUrl为对应快递的查询前缀规则即可

方案2：完善原有IE模拟操作版本 #

如果后续需要适配没有固定查询链接规则的快递网站，可以用这个模拟操作逻辑，下面补全你原有代码的缺失部分：

Sub Get_Link_Tracking()
    Dim internet As Object
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim trackingNo As String
    Dim searchInput As Object
    Dim searchBtn As Object
    
    ' 修改为你实际的工作表名称
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' 物流单号所在列的序号，A列对应1、B列对应2，以此类推
    Const trackingCol As Long = 1
    lastRow = ws.Cells(ws.Rows.Count, trackingCol).End(xlUp).Row
    
    Set internet = CreateObject("InternetExplorer.Application")
    internet.Visible = True
    internet.Navigate "https://www.purolator.com/en/shipping/tracker"
    
    ' 等待页面加载完成
    Do While internet.Busy Or internet.readyState <> 4
        DoEvents
    Loop
    
    For i = 2 To lastRow
        trackingNo = Trim(ws.Cells(i, trackingCol).Value)
        If Len(trackingNo) = 0 Then GoTo nextRow
        
        ' 定位单号输入框填入单号
        Set searchInput = internet.document.getElementById("tracking-pins")
        searchInput.Value = trackingNo
        
        ' 定位查询按钮触发点击
        Set searchBtn = internet.document.getElementsByClassName("btn btn-primary")(0)
        searchBtn.Click
        
        ' 等待查询结果页面加载完成
        Do While internet.Busy Or internet.readyState <> 4
            DoEvents
        Loop
        ' 预留2秒确保页面跳转完成
        Application.Wait Now + TimeValue("00:00:02")
        
        ' 给当前单元格插入超链接
        ws.Hyperlinks.Add _
            Anchor:=ws.Cells(i, trackingCol), _
            Address:=internet.LocationURL, _
            TextToDisplay:=trackingNo
        
nextRow:
    Next i
    
    ' 处理完成后关闭IE释放资源
    internet.Quit
    Set internet = Nothing
    MsgBox "所有单号超链接生成完成"
End Sub

*注意：该方案依赖IE浏览器，Windows 11系统没有内置IE的用户优先使用方案1；如果后续Purolator官网改版修改了页面元素ID，需要重新审查元素更新对应的定位代码。

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