Excel VBA宏自动翻页求助：如何循环修改__doPostBack中的页码

你之前的循环代码存在两个核心问题：

1. JS参数格式错误：__doPostBack的第二个参数是字符串，必须用单引号包裹，你拼接的URL里缺少了这对单引号
2. 错误处理逻辑错误：错误处理标签直接跳转到退出逻辑，导致循环刚遇到一次错误就直接终止，无法继续后续页码抓取

下面是修正后的完整宏代码，实现自动循环翻页：

Sub Fetch_Data_AutoPagination()
    Dim IE As Object
    Dim HTMLdoc As Object
    Dim resultsTable As Object
    Dim tRow As Object, tCell As Object
    Dim destCell As Range
    Dim LR As Long, i As Long
    Dim postBackUrl As String
    
    '初始化IE对象
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = False '如需调试可改为True
    
    Application.StatusBar = "数据抓取中，请稍候..."
    Application.ScreenUpdating = False '关闭屏幕刷新提升效率
    
    '打开目标页面
    IE.Navigate "https://www.bseindia.com/markets/debt/TradenSettlement.aspx"
    Do
        DoEvents
    Loop Until IE.ReadyState = 4 And Not IE.Busy
    
    Set HTMLdoc = IE.Document
    
    '写入第一页数据
    With ActiveSheet
        Set destCell = .Range("A1")
    End With
    WriteTableData resultsTable:=HTMLdoc.getElementById("ContentPlaceHolder1_GridViewrcdsFC"), destCell:=destCell
    
    '循环翻页抓取数据
    For i = 2 To 50 '可根据实际页码范围调整上限
        '拼接正确的__doPostBack调用，注意参数的单引号
        postBackUrl = "javascript:__doPostBack('ctl00$ContentPlaceHolder1$GridViewrcdsFC','Page$" & CStr(i) & "')"
        
        On Error Resume Next
        IE.Navigate postBackUrl
        '等待页面加载完成
        Do
            DoEvents
        Loop Until IE.ReadyState = 4 And Not IE.Busy
        On Error GoTo ErrorHandler
        
        '检查页面是否加载成功（表格是否存在）
        Set resultsTable = HTMLdoc.getElementById("ContentPlaceHolder1_GridViewrcdsFC")
        If resultsTable Is Nothing Then
            MsgBox "页码" & i & "不存在，终止抓取"
            Exit For
        End If
        
        '定位到数据写入的起始行（跳过重复表头）
        LR = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
        With ActiveSheet
            Set destCell = .Range("A" & LR + 1) '直接从下一行开始，避免覆盖和重复表头
        End With
        
        '写入当前页数据
        WriteTableData resultsTable:=resultsTable, destCell:=destCell
    Next i
    
Cleanup:
    '清理资源
    IE.Quit
    Set IE = Nothing
    Set HTMLdoc = Nothing
    
    '删除重复的表头行
    Dim lrow As Long, index As Long
    Dim header As String
    header = ActiveSheet.Range("A1").Value
    lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    
    '从后往前删除，避免行号错乱
    For index = lrow To 2 Step -1
        If ActiveSheet.Range("A" & index).Value = header Then
            ActiveSheet.Rows(index).Delete
        End If
    Next
    
    Application.StatusBar = "数据抓取完成"
    Application.ScreenUpdating = True
    MsgBox "数据抓取成功！"
    Exit Sub
    
ErrorHandler:
    MsgBox "页码" & i & "加载失败：" & Err.Description, vbCritical
    Resume Cleanup
End Sub

'辅助子程序：写入表格数据到指定单元格
Sub WriteTableData(resultsTable As Object, destCell As Range)
    Dim tRow As Object, tCell As Object
    For Each tRow In resultsTable.Rows
        For Each tCell In tRow.Cells
            destCell.Offset(tRow.RowIndex, tCell.cellIndex).Value = tCell.innerText
        Next
    Next
End Sub

关键优化点说明 #

• 正确拼接JS调用：确保Page$i被单引号包裹，符合__doPostBack的参数要求
• 完善的页面等待逻辑：同时检查ReadyState=4和Not IE.Busy，避免页面未完全加载就开始抓取
• 模块化数据写入：把表格数据写入逻辑抽成子程序，简化主代码
• 安全的错误处理：遇到错误时提示具体信息并清理资源，避免IE进程残留
• 高效的重复表头删除：从后往前删除行，避免删除行后导致的行号错乱

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