在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

另一答案

Answer 2

另一答案