在access vba中输出多个报告导致错误3014，打开的表太多

Question

我正在使用 VBA 和 MS Access 2010 从我们公司的数据库中编写报告。我有近 3000 名员工，我需要为每位员工编写 10 份不同的报告，然后将这 10 份报告合并为每位员工的一份 pdf。然后将这些文件保存在按工作地点排序的目录中。

我编写的代码效果很好，并且可以完成预期的工作，除了在写出 1024 报告后我收到一个错误。 Err.Number 3014，无法再打开表。

根据我在 Internet 上可以找到的信息，这与 Jet 表引用有关，并且很难排除故障。我遵循了我能找到的建议，我相信我在使用后已经正确关闭了所有内容。我认为问题可能出现在合并 pdf 文件例程中，但即使您将其注释掉，它仍然会在 1024 份报告中失败。

我希望此代码能够处理大约 30,000 份报告而不会失败。任何想法或想法将不胜感激。

Public Function combined_report(EmployeeSelectionQuery As String)

Dim DefaultPdfDir As String     ' contains path to where pdf files will be written on local computer
Dim rst As Recordset            ' recordset object for set of selected plots from query:Employees_COMBINED
Dim n_employees As Integer      ' Number of employees selected by query:Employees_COMBINED
Dim current_employee_number As Variant     ' current employee number, used when writing combined reports
Dim current_duty_station As Variant     ' current duty station, used when writing combined reports
Dim strWhere As String          ' String containing the where clause for the combined openreport WhereCondition
Dim arrayReport(0 To 9) As Variant      ' Array containing all the reports to be processed in combined
Dim strReport As Variant        ' String containing prefix to reports
Dim tempOutputPdfFile As String ' Individual report before they are combined
Dim combinedOutputPdfFile As String     ' Combined report composed of individual reports REQUIRES that adobe acrobat - full version be installed.
Dim intCounter As Integer       ' A iteration counter used to update the status bar
Dim combOutputPdfFile As String ' Combined Output Pdf File Path

On Error GoTo error_handler

Set rst = CurrentDb.OpenRecordset(EmployeeSelectionQuery)

'Force Access to accurately update .RecordCount property
rst.MoveLast
rst.MoveFirst
n_employees = rst.RecordCount

If n_employees = 0 Then
  Call MsgBox("No employees selected by query: " & EmployeeSelectionQuery, vbCritical + vbOKOnly + vbDefaultButton1, "No Employees Selected")
  combined_report = False
Else

  DoCmd.Hourglass True

  'Set HomeDir and create output folder
  DefaultPdfDir = "C:\temp"
  MakeDir DefaultPdfDir


  arrayReport(0) = "REPORT_1"
  arrayReport(1) = "REPORT_2"
  arrayReport(2) = "REPORT_3"
  arrayReport(3) = "REPORT_4"
  arrayReport(4) = "REPORT_5"
  arrayReport(5) = "REPORT_6"
  arrayReport(6) = "REPORT_7"
  arrayReport(7) = "REPORT_8"
  arrayReport(8) = "REPORT_9"
  arrayReport(9) = "REPORT_10"


  'Set counter to zero
  intCounter = 0

  Do While (Not (rst.EOF))

        'Get employee number and duty station to name the files and sort by directory
        current_employee_number = rst!EN
        current_duty_station = rst!DUTY_STATION

        'Make the output directory if it doesn't exist and specify the output file path
        MakeDir "C:\Final\" & current_duty_station
        combOutputPdfFile = "C:Final\" & current_duty_station & "\" & current_employee_number & ".pdf"


        'Increment counter by one for each employee processed
        intCounter = intCounter + 1

        'Where statement used by DoCmd.OpenReport to run the report for one employee only
        strWhere = "[EN] = " & current_employee_number & " OR [en] = " & current_employee_number

        'Process each report
        For Each strReport In arrayReport

            'Specify the file path and name for the report
            tempOutputPdfFile = DefaultPdfDir & "\" & current_employee_number & "_" & strReport & ".pdf"

            'Update Status Bar
            Status ("Processing " & intCounter & " of " & n_employees & ": " & tempOutputPdfFile)

            'Open the report and write it to a pdf file
            DoCmd.OpenReport strReport, acViewPreview, "", strWhere, acHidden
            DoCmd.OutputTo acOutputReport, strReport, acFormatPDF, tempOutputPdfFile, False
            DoCmd.Close acReport, strReport, acSaveNo

            'Merge the files
            MergePdfFiles combOutputPdfFile, tempOutputPdfFile, combOutputPdfFile


        Next strReport

        'Delete the last temp file before moving on to the next employee
        DeleteFile tempOutputPdfFile

    rst.MoveNext

  Loop

  'Close everything up
  Status ("")
  rst.Close
  Set rst = Nothing
  DoCmd.Hourglass False
  combined_report = True

End If

Exit Function
error_handler:
    MsgBox "Error: " & Err.Number & vbNewLine & _
           "Description: " & Err.Description, vbCritical, "combined_report function error"
    DoCmd.Hourglass False
    combined_report = False
    Status ("")

End Function

Answer 1

尝试注释掉“DoCmd.OutputTo”语句，看看是否出错。我猜这个命令除了在前面的 DoCmd.OpenReport 行中打开的报告之外，还打开了一个报告。

（我本来只是将其添加为评论，但 SO 不会让我这样做）

Answer 2

我使用 DoCmd.OpenReport 是因为它内置了 WHERE 子句功能。阅读 JayRO-GreyBeard 的评论后，我意识到同时使用 OpenReport 和 OutputTo 方法似乎是多余的。因此，我重写了代码，删除了 OpenReport 调用，并在调用 OutputTo 之前修改了每个报告的 QueryDef。

由于某种原因，这解决了这个问题。

感谢您的帮助！

Answer 3

3014 错误我也遇到了同样的问题。我正在将报告输出为 PDF，同时在屏幕上为用户显示报告（同时使用 Docmd.OpenReport 和 Docmd.OutputTo，这对于单个报告来说效果很好。但是，当我批量运行报告并导出/显示报告时.（该工具自动生成采购订单）3014错误将出现在100个左右的报告中。

当我关闭 DoCmd.OpenReport 以将报告批量运行为 PDF 时。 3014 错误消失了。我重新测试过，1000s以内的报表批量运行也没有问题。