如何实现从Excel Sheet1批量读取URL并爬取数据保存至Sheet2？

以下是完善后的VBA代码，实现从Sheet1的A1:A1000读取URL，批量爬取指定元素并写入Sheet2对应行：

Sub BatchCrawlData()
    Dim ie As Object
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim i As Integer
    Dim url As String
    Dim ht As Object
    
    ' 初始化IE对象
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = False ' 可选：设为True可显示IE窗口调试
    
    ' 绑定源工作表和目标工作表，减少重复调用提升效率
    Set wsSource = Workbooks("1000").Worksheets("Sheet1")
    Set wsTarget = Workbooks("1000").Worksheets("Sheet2")
    
    ' 遍历A1到A1000的URL
    For i = 1 To 1000
        url = wsSource.Range("A" & i).Value
        
        ' 跳过空URL
        If url = "" Then
            wsTarget.Range("C" & i & ":E" & i).ClearContents ' 清空对应行数据
            GoTo NextRow
        End If
        
        ' 导航到目标URL
        ie.navigate url
        
        ' 等待页面加载完成（关键：必须等IE就绪才能操作DOM）
        Do While ie.Busy Or ie.ReadyState <> 4
            DoEvents
        Loop
        
        ' 获取页面文档对象
        Set ht = ie.document
        
        ' 爬取指定元素并写入目标工作表，添加错误处理防止元素缺失
        On Error Resume Next
        wsTarget.Range("C" & i).Value = ht.getElementById("formNo").Value
        wsTarget.Range("D" & i).Value = ht.getElementById("fullName").Value
        wsTarget.Range("E" & i).Value = ht.getElementById("idNo").Value
        On Error GoTo 0 ' 恢复默认错误处理
        
NextRow:
    Next i
    
    ' 关闭IE并释放资源
    ie.Quit
    Set ie = Nothing
    Set wsSource = Nothing
    Set wsTarget = Nothing
    
    MsgBox "批量爬取完成！"
End Sub

关键优化说明 #

• 工作表对象绑定：提前把Sheet1和Sheet2赋值给变量，避免反复调用Workbooks("1000").Worksheets(...)，提升代码执行效率。
• 循环遍历逻辑：通过For i = 1 To 1000遍历A列所有目标行，满足批量处理需求。
• 空URL跳过：判断单元格为空时直接跳过，避免无效导航，同时清空目标行对应位置的数据。
• 页面加载等待：添加Do While循环等待IE就绪（ReadyState = 4表示加载完成），这是原代码缺失的核心逻辑，否则会因页面未加载完成导致DOM操作报错。
• 错误处理：用On Error Resume Next捕获元素不存在的异常，防止单个页面数据缺失导致整个程序中断，之后用On Error GoTo 0恢复默认错误处理。
• 资源释放：最后关闭IE并释放所有对象，避免内存泄漏。

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