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

Question

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

我编写的代码很有效，并且在写出1024个报告后我的工作意图是除了我收到错误。 Err.Number 3014，无法再打开表格。

根据我在互联网上可以找到的内容，这与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行中打开报告之外还打开了一个报告。

（我本来只是添加了这个评论，但是不会让我这么做）

Answer 2

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

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

谢谢您的帮助！

Answer 3

我对3014错误有同样的问题。我正在将报告输出为PDF，同时在屏幕上为用户显示报告（使用Docmd.OpenReport和Docmd.OutputTo，这对于单个报告工作正常。但是，当我批量运行报告并导出/显示报告时。（工具自动生成采购订单）3014错误将发生在大约100个左右的报告中。

当我关闭DoCmd.OpenReport以批量运行报告为PDF时。 3014错误消失了。我已经重新测试了，并且无法在1000s内运行报告批处理。