登录验证后抓取网页表格报错(错误91)：对象变量未设置

核心问题 #

错误91（对象变量或With块变量未设置）是因为HTMLTable对象未成功获取，后续遍历表格行时触发报错。主要原因有两个：

• 登录跳转后的页面等待不充分，DOM元素还未完全渲染就尝试获取
• 元素定位逻辑错误，目标表格的定位方式不符合实际DOM结构

修复步骤 #

1. 优化页面等待机制 #

原有的ReadyState检查仅能判断文档加载完成，无法覆盖JS动态渲染的情况。替换为更可靠的等待逻辑，确保目标元素加载完成：

' 点击登录后等待页面跳转及渲染
Do While IE.ReadyState <> 4 Or IE.Busy
    DoEvents
Loop
' 增加固定延迟（根据页面加载速度调整）
Application.Wait Now + TimeValue("00:00:02")
' 循环检查目标元素，超时10秒则退出
Dim waitTime As Double
waitTime = Now + TimeValue("00:00:10")
Do
    DoEvents
    On Error Resume Next
    Set formObj = Doc.getElementById("RecentInventorylistform")
    On Error GoTo 0
Loop Until Not formObj Is Nothing Or Now > waitTime

If formObj Is Nothing Then
    MsgBox "超时未找到目标表单"
    IE.Quit
    Exit Sub
End If

2. 修正元素定位逻辑 #

从你提供的HTML截图来看，RecentInventorylistform是表单（<form>）的ID，而非表格本身。需要先获取表单，再定位内部的表格：

' 先获取表单对象，再提取内部第一个表格
Dim formObj As Object
Set formObj = Doc.getElementById("RecentInventorylistform")
Set HTMLTable = formObj.getElementsByTagName("table")(0)

' 额外增加检查，避免表格不存在的情况
If HTMLTable Is Nothing Then
    MsgBox "未找到目标表格"
    IE.Quit
    Exit Sub
End If

3. 修复数据写入逻辑 #

原代码将所有单元格都写入A列，导致数据堆叠。修改为行、列同时偏移，保证表格结构正常：

Dim myRow As Long, myCol As Long
myRow = 0

For Each TableRow In HTMLTable.getElementsByTagName("tr")
    myCol = 0 ' 每行开始重置列偏移
    For Each TableCell In TableRow.getElementsByTagName("td")
        Worksheets("Sheet1").Range("A5").Offset(myRow, myCol).Value = TableCell.innerText
        myCol = myCol + 1
    Next TableCell
    myRow = myRow + 1 ' 每行结束后行偏移+1
Next TableRow

4. 补充常量定义 #

原代码中READYSTATE_COMPLETE未定义，需在模块顶部添加常量：

Const READYSTATE_COMPLETE = 4

或者直接将等待语句中的READYSTATE_COMPLETE替换为数值4。

完整修复代码 #

Const READYSTATE_COMPLETE = 4

Private Sub CommandButton3_Click()
    Dim IE As Object
    Dim Doc As HTMLDocument
    Dim HTMLTable As Object
    Dim formObj As Object
    Dim TableRow As Object
    Dim TableCell As Object
    Dim myRow As Long, myCol As Long
    Dim waitTime As Double
    
    ' 创建IE实例
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
    
    ' 导航到登录页
    IE.Navigate "https://www.myfueltanksolutions.com/validate.asp"
    
    ' 等待登录页加载完成
    Do While IE.ReadyState <> 4 Or IE.Busy
        DoEvents
    Loop
    
    Set Doc = IE.Document
    
    ' 填写登录信息
    Doc.all("CompanyID").Value = "ID"
    Doc.all("UserId").Value = "Username"
    Doc.all("Password").Value = "Password"
    
    ' 点击登录按钮
    Doc.all("btnSubmit").Click
    
    ' 等待登录跳转及页面渲染
    Do While IE.ReadyState <> 4 Or IE.Busy
        DoEvents
    Loop
    Application.Wait Now + TimeValue("00:00:02")
    
    ' 定位表单及内部表格
    Set formObj = Doc.getElementById("RecentInventorylistform")
    If formObj Is Nothing Then
        MsgBox "未找到目标表单"
        IE.Quit
        Exit Sub
    End If
    Set HTMLTable = formObj.getElementsByTagName("table")(0)
    If HTMLTable Is Nothing Then
        MsgBox "未找到目标表格"
        IE.Quit
        Exit Sub
    End If
    
    ' 遍历表格并写入Excel
    myRow = 0
    For Each TableRow In HTMLTable.getElementsByTagName("tr")
        myCol = 0
        For Each TableCell In TableRow.getElementsByTagName("td")
            Worksheets("Sheet1").Range("A5").Offset(myRow, myCol).Value = TableCell.innerText
            myCol = myCol + 1
        Next TableCell
        myRow = myRow + 1
    Next TableRow
    
    ' 退出登录并关闭IE
    IE.Navigate "https://www.myfueltanksolutions.com/signout.asp?action=rememberlogin"
    Do While IE.ReadyState <> 4 Or IE.Busy
        DoEvents
    Loop
    IE.Quit
End Sub

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