在Access中使用Excel对象时出现运行时错误91

问题诊断 #

你的函数首次运行正常、二次运行触发错误91，核心原因是过度依赖Excel的活动对象（Select/Selection/ActiveCell/ActiveWindow），这些对象的指向会受Excel实例的残留状态、焦点变化影响，导致二次运行时对象引用失效。同时错误处理中未彻底清理Excel进程，残留的实例会干扰后续运行。

修复后的代码 #

Public Function ExportToExcelEM(Numbcases, strObjectType As String, strObjectName As String, Optional strSheetName As String, Optional strFileName As String)

    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim intCount As Integer
    Const xlToRight As Long = -4161
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    Const xlContinuous As Long = 1
    Const xlSolid As Long = 1 ' 补充缺失的常量定义
    Const xlAutomatic As Long = -4105
    Const xlContext As Long = -5002

    On Error GoTo ExportToExcel_Err
    DoCmd.Hourglass True

    Select Case strObjectType
        Case "Table", "Query"
            Set rst = CurrentDb.OpenRecordset(strObjectName, dbOpenDynaset, dbSeeChanges)
        Case "Form"
            Set rst = Forms(strObjectName).RecordsetClone
        Case "Report"
            Set rst = CurrentDb.OpenRecordset(Reports(strObjectName).RecordSource, dbOpenDynaset, dbSeeChanges)
    End Select

    If rst.RecordCount = 0 Then
        MsgBox "No records to be exported.", vbInformation, GetDBTitle
        DoCmd.Hourglass False
    Else
        On Error Resume Next
        Set ApXL = GetObject(, "Excel.Application")
        If Err.Number <> 0 Then
            Set ApXL = CreateObject("Excel.Application")
        End If
        Err.Clear
        On Error GoTo ExportToExcel_Err

        Set xlWBk = ApXL.Workbooks.Add
        ApXL.Visible = False

        Set xlWSh = xlWBk.Worksheets("Sheet1")
        If Len(strSheetName) > 0 Then
            xlWSh.Name = Left(strSheetName, 31)
        End If

        ' 替换Select逻辑：直接写入表头，不依赖ActiveCell
        For intCount = 0 To rst.Fields.Count - 1
            xlWSh.Cells(1, intCount + 1).Value = rst.Fields(intCount).Name
        Next intCount

        rst.MoveFirst
        xlWSh.Range("A2").CopyFromRecordset rst

        ' 格式化操作：全程直接引用目标工作表，避免Select/Selection
        With xlWSh
            ' 定义表头范围
            Dim headerRange As Object
            Set headerRange = .Range(.Cells(1, 1), .Cells(1, rst.Fields.Count))
            
            ' 设置表头填充与边框
            With headerRange
                .Interior.Pattern = xlSolid
                .Interior.PatternColorIndex = xlAutomatic
                .Interior.TintAndShade = -0.25
                .Interior.PatternTintAndShade = 0
                .Borders.LineStyle = xlNone
                .AutoFilter
            End With

            ' 设置表头对齐格式
            With headerRange
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = True
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With

            ' 自动调整列宽行高
            .Cells.EntireColumn.AutoFit
            .Cells.EntireRow.AutoFit

            ' 冻结窗格：仅需一次Select确保窗口焦点
            .Range("B2").Select
            ApXL.ActiveWindow.FreezePanes = True

            ' 设置全局单元格不换行
            .Cells.WrapText = False
        End With

        xlWBk.SaveAs FileName:=strFileName, FileFormat:=51
        xlWBk.Close SaveChanges:=False
        ' 主动退出Excel实例，避免残留进程
        ApXL.Quit
    End If

rst.Close
Set rst = Nothing
DoCmd.Hourglass False

ExportToExcel_Exit:
    DoCmd.Hourglass False
    ' 确保释放所有对象
    Set xlWSh = Nothing
    Set xlWBk = Nothing
    Set ApXL = Nothing
    Exit Function

ExportToExcel_Err:
    DoCmd.SetWarnings True
    ' 报错时也强制退出Excel并清理对象
    If Not ApXL Is Nothing Then
        ApXL.Quit
    End If
    Set xlWSh = Nothing
    Set xlWBk = Nothing
    Set ApXL = Nothing
    If Not rst Is Nothing Then rst.Close
    Set rst = Nothing
    MsgBox Err.Description, vbExclamation, Err.Number
    DoCmd.Hourglass False
    Resume ExportToExcel_Exit

End Function

关键修复点 #

• 移除Select/Selection依赖：所有Excel操作直接通过xlWSh（目标工作表）、headerRange（表头范围）等明确对象执行，彻底避免活动对象指向错误的问题。
• 强制清理Excel实例：无论正常结束还是报错，都调用ApXL.Quit，防止残留Excel进程干扰后续运行。
• 简化表头写入逻辑：用For循环替代Do+Select的写法，更高效且可靠。
• 补充缺失常量：手动定义Excel内置常量（如xlSolid），避免后期绑定环境下的常量未定义问题。

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