【问题标题】:Error 3011 when doing transferspreadsheet进行转移电子表格时出现错误 3011
【发布时间】:2022-09-27 21:27:25
【问题描述】:

通过 Access 运行 VBA。

尝试将选择查询从 access 转移到 excel。

如果我一起运行所有代码,那么在第二个 DoCmd.TransferSpreadsheet 上会出现 3011 运行时错误。

如果我注释掉与 PATH1 相关的所有代码,那么第二个 DoCmd.TransferSpreadhseet 运行良好。

Microsoft Access 数据库引擎找不到对象 \'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

fpath = \"PATH1\"
strFileExists = Dir(fpath)
If strFileExists <> \"\" Then

    \'set variables for Excel
    Set xlappC = CreateObject(\"Excel.Application\")
    Set xlbookC = xlappC.Workbooks.Open(fpath)
    Set xlsheetC = xlbookC.Worksheets(\"Audit Fees Remittance\")
    With xlappC
        .Visible = False
        .DisplayAlerts = False
        .Workbooks.Open fpath

        \'Update Raw Data Cad and CSCT tab
        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, \"PATH1\", True, \"TabFA8\"
                .Rows(2).EntireRow.Delete
                rst.Close
                Set rst = Nothing
                Else
                    rst.Close
                    Set rst = Nothing
                End If
                tempValue2 = \"$A$2:\" & tempR2
                .Range(tempValue2).EntireColumn.AutoFit
                tempR1 = \"\"
                tempR2 = \"\"
            End With

\'Remit for US
fpath = \"PATH2\"
strFileExists = Dir(fpath)
If strFileExists <> \"\" Then
    \'set variables for Excel
    Set xlappU = CreateObject(\"Excel.Application\")
    Set xlbookU = xlappU.Workbooks.Open(fpath)
    Set xlsheetU = xlbookU.Worksheets(\"Remittance Tab\")
    With xlappU
        .Visible = False
        .DisplayAlerts = False
        .Workbooks.Open fpath

        \'Update INTL Remittance tab
        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 range for renaming
                \'this will allow TransferSpreadhseet to know where to export to on the sheet
                Set rngU = .Range(tempR1, tempR2)
                rngU.Name = \"TabUSR2\"
                DoCmd.TransferSpreadsheet acExport, 10, \"Weekly US 5 Remittance Tab B DHLG and Jas\", \"PATH2\", True, \"TabUSR2\"
                \'delete row with headers
                .Rows(row).EntireRow.Delete
                rst.Close
                Set rst = Nothing
                Else
                    rst.Close
                    Set rst = Nothing
                End If
            End With
  • TabUSR1 在代码中的什么位置?有趣的DoCmd.TransferSpreadsheet 甚至可以在打开的工作簿上工作!
  • DoCmd.TransferSpreadsheet 实际上在 TabUSR1 处中断,但 TabUSR2 是 TabUSR1 代码的复制和粘贴,稍作修改。我将尝试关闭工作簿,然后进行传输
  • 这解决了我的问题!!!!

标签: vba ms-access


【解决方案1】:

虽然我无法准确理解或诊断您的问题,但为了维护和可读性,请考虑将所有 Excel 和 Access 进程分开。避免走过去打开具有两个对象库的文件。因此,使用您创建的记录集考虑 Excel 的 Range.CopyFromRecordset 而不是 Access 的 DoCmd.TransferSpreadsheet

...
Set rst = CurrentDb.OpenRecordset("Weekly CAN 5 Raw Data to include csct")
...

Set rngC = .Range(tempR1, tempR2)
rngC.Name = "TabFA8"
rngC.CopyFromRecordset rst
rst.Close
...
Set rst = CurrentDb.OpenRecordset("Weekly US 5 Remittance Tab B DHLG and Jas")
...

Set rngU = .Range(tempR1, tempR2)
rngU.Name = "TabUSR2"
rngU.CopyFromRecordset rst
rst.Close

【讨论】:

  • 虽然这确实允许编码在没有 3011 错误的情况下完成,但我从其他一些变量中得到了一些奇怪的结果。 IE... tempValue4 = rst!NumImages,然后我有 .Range("B23").Value2 = tempValue4 这是查询中的一个数字值,但正在加载到 Excel 作为日期
【解决方案2】:

Parfait 建议关闭工作簿然后执行 TransferSpreadsheet 解决了我的问题。

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 2018-08-23
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多