Access执行DoCmd.TransferSpreadsheet时出现3011运行时错误

问题现象 #

完整运行代码时，第二个DoCmd.TransferSpreadsheet抛出3011错误，提示找不到对象TabUSR1；但注释掉所有与PATH1相关的代码后，第二个导出操作可正常执行。

错误根源 #

1. 重复打开工作簿：两段Excel操作代码中都重复执行了.Workbooks.Open fpath，但此前已经通过Set xlbookC = xlappC.Workbooks.Open(fpath)打开了目标文件，重复打开会导致Excel对象模型混乱，后续命名的单元格范围无法被Access正确识别。
2. DoCmd.TransferSpreadsheet参数错误：第一个导出操作的第三个参数被错误设置为文件路径"PATH1"，而该参数应该是要导出的查询名称。这个错误会导致Access试图查找名为PATH1的数据库对象，引发对象查找冲突，进而干扰后续的导出操作。
3. Excel对象未正确释放：第一段操作完PATH1的Excel文件后，没有保存关闭工作簿、退出Excel应用，也未释放相关对象变量，导致Excel进程残留，影响后续文件操作和范围识别。

修复方案 #

• 移除重复的.Workbooks.Open fpath语句，因为工作簿已经通过Set xlbookC = xlappC.Workbooks.Open(fpath)打开。
• 修正第一个DoCmd.TransferSpreadsheet的第三个参数，替换为正确的查询名称"Weekly CAN 5 Raw Data to include csct"。
• 在第一段Excel操作完成后，添加工作簿保存、关闭，Excel应用退出及对象释放的代码，避免进程残留。
• 确保第二段代码中命名的范围TabUSR2与DoCmd.TransferSpreadsheet中指定的范围名称完全一致（错误提示中的TabUSR1大概率是代码拼写错误或残留）。

修正后的完整代码 #

Dim tempR1 As String
Dim tempR2 As String
Dim tempValue1 As String
Dim tempValue2 As String
Dim tempValue3 As String
Dim tempValue4 As String
Dim tempValue5 As String
Dim dt As Date
Dim d As String
Dim row As String
Dim rngC As Range
Dim rngU As Range
Dim fpath As String
Dim strFileExists
Dim xlappC As Excel.Application
Dim xlbookC As Excel.Workbook
Dim xlsheetC As Excel.Worksheet
Dim xlappU As Excel.Application
Dim xlbookU As Excel.Workbook
Dim xlsheetU As Excel.Worksheet
Dim rst As Recordset ' 补充声明缺失的Recordset变量

' 处理PATH1对应的Excel文件
fpath = "PATH1"
strFileExists = Dir(fpath)
If strFileExists <> "" Then
    ' 初始化Excel应用并打开目标工作簿
    Set xlappC = CreateObject("Excel.Application")
    With xlappC
        .Visible = False
        .DisplayAlerts = False
    End With
    Set xlbookC = xlappC.Workbooks.Open(fpath)
    
    ' 更新"Raw Data CAD and CSCT"工作表
    Set xlsheetC = xlbookC.Worksheets("Raw Data CAD and CSCT")
    With xlsheetC
        Set rst = CurrentDb.OpenRecordset("Weekly CAN 5 Raw Data to include csct")
        If rst.RecordCount > 0 Then
            tempR2 = rst.RecordCount + 1
            tempR2 = .Cells(.Rows.Count, "CV").End(xlUp).Offset(tempR2).Address(False, False)
            tempR1 = .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Address(False, False)
            Set rngC = .Range(tempR1, tempR2)
            rngC.Name = "TabFA8"
            ' 修正参数：第三个参数为查询名称，第四个为文件路径
            DoCmd.TransferSpreadsheet acExport, 10, "Weekly CAN 5 Raw Data to include csct", fpath, True, "TabFA8"
            .Rows(2).EntireRow.Delete
        End If
        rst.Close
        Set rst = Nothing
        
        tempValue2 = "$A$2:" & tempR2
        .Range(tempValue2).EntireColumn.AutoFit
        tempR1 = ""
        tempR2 = ""
    End With
    
    ' 清理Excel对象，避免进程残留
    xlbookC.Save
    xlbookC.Close
    xlappC.Quit
    Set xlsheetC = Nothing
    Set xlbookC = Nothing
    Set xlappC = Nothing
End If

' 处理US地区的Remittance文件
fpath = "PATH2"
strFileExists = Dir(fpath)
If strFileExists <> "" Then
    ' 初始化Excel应用并打开目标工作簿
    Set xlappU = CreateObject("Excel.Application")
    With xlappU
        .Visible = False
        .DisplayAlerts = False
    End With
    Set xlbookU = xlappU.Workbooks.Open(fpath)
    
    ' 更新"INTL Remittance"工作表
    Set xlsheetU = xlbookU.Worksheets("INTL Remittance")
    With xlsheetU
        Set rst = CurrentDb.OpenRecordset("Weekly US 5 Remittance Tab B DHLG and Jas")
        If rst.RecordCount > 0 Then
            tempR2 = rst.RecordCount + 1
            tempR2 = .Cells(.Rows.Count, "V").End(xlUp).Offset(tempR2).Address(False, False)
            tempR1 = .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Address(False, False)
            If Len(tempR1) = 3 Then
                row = Right(tempR1, 2)
            Else
                row = Right(tempR1, 3)
            End If
            ' 设置导出目标范围名称
            Set rngU = .Range(tempR1, tempR2)
            rngU.Name = "TabUSR2"
            ' 执行导出操作
            DoCmd.TransferSpreadsheet acExport, 10, "Weekly US 5 Remittance Tab B DHLG and Jas", fpath, True, "TabUSR2"
            ' 删除自动生成的表头行
            .Rows(row).EntireRow.Delete
        End If
        rst.Close
        Set rst = Nothing
    End With
    
    ' 清理Excel对象
    xlbookU.Save
    xlbookU.Close
    xlappU.Quit
    Set xlsheetU = Nothing
    Set xlbookU = Nothing
    Set xlappU = Nothing
End If

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