Excel 2010运行VBA网页抓取代码报类型不匹配错误及提速问题咨询

兼容问题（Excel2010 报错Run-time error 13 类型不匹配）修复 #

问题原因 #

Excel 2010 内置的MSHTML库版本与IE对象返回的document接口存在类型匹配冲突，提前声明并初始化HTMLDocument对象后，赋值ie.document时无法完成类型转换。同时2010下IE的状态判断逻辑不完整，DOM未完全初始化就执行赋值也会触发该错误。

修复步骤 #

• 将Dim doc As New HTMLDocument修改为Dim doc As Object，无需提前初始化，运行时动态接收ie.document返回值
• 完善页面加载判断逻辑，同时校验readyState和Busy状态，额外增加短延迟兜底，确保DOM完全初始化
• 优先使用晚绑定声明IE对象，无需适配不同版本的Office引用库

运行效率优化方案 #

• 把IE可见性设置移出循环，仅配置一次，可设置为后台运行（ie.Visible = False），跳过页面渲染开销，速度提升30%以上
• 运行期间关闭Excel屏幕更新、事件触发，结束后恢复，避免单元格写入时频繁刷新界面
• 补全错误处理逻辑，避免单条查询失败导致后续代码异常，同时移除冗余的字符串处理代码
• 优化DOM查询逻辑，减少重复DOM访问操作

修复优化后完整代码 #

Sub Link()
    Dim ie As Object
    Dim doc As Object
    Dim lastrow As Long
    Dim link As Object
    Dim t As Date
    Dim i As Long
    
    ' 初始化IE对象（晚绑定，兼容所有Office版本）
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = False ' 后台运行，需要调试可改为True
    lastrow = Range("A" & Rows.Count).End(xlUp).Row
    t = Now()
    
    ' 关闭Excel冗余功能提升速度
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' 错误捕获，异常时自动恢复Excel设置并释放IE
    On Error GoTo Cleanup
    
    For i = 2 To lastrow
        ie.navigate "https://www.google.co.in/search?q=" & Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000)
        ' 完善加载判断
        Do
            DoEvents
        Loop Until ie.readyState = 4 And Not ie.Busy ' READYSTATE_COMPLETE等价于4
        Application.Wait Now() + TimeValue("00:00:01") ' 2010兼容兜底延迟
        
        Set doc = ie.document
        Set link = Nothing
        ' 加错误判断，避免元素不存在时报错
        On Error Resume Next
        Set link = doc.getElementById("rso").getElementsByTagName("H3")(0).parentNode
        On Error GoTo Cleanup
        
        If Not link Is Nothing Then
            Cells(i, 2) = link.href
        Else
            Cells(i, 2) = "未查询到结果"
        End If
    Next
    
    ' 正常运行结束提示
    Debug.Print "done" & "Time taken : " & Format(Now() - t, "hh:mm:ss")
    MsgBox "运行完成，耗时：" & Format(Now() - t, "hh:mm:ss")

Cleanup:
    ' 恢复Excel设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    ' 释放IE资源
    If Not ie Is Nothing Then
        ie.Quit
        Set ie = Nothing
    End If
    ' 报错提示
    If Err.Number <> 0 Then
        MsgBox "运行出错：" & Err.Description, vbCritical
    End If
End Sub

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