在 access vba 中输出多个报告导致错误 3014,打开的表过多
Outputting multiple reports in access vba causes error 3014, too many tables open
我正在使用 VBA 和 MS Access 2010 从我们公司的数据库中编写报告。我有近 3000 名员工,我需要为每位员工写出 10 份不同的报告,然后将这 10 份报告合并到每位员工一份 pdf。然后将这些文件保存在按其工作地点排序的目录中。
我写的代码工作得很好并且完成了预期的工作除了在写出 1024 份报告后我收到一个错误。 Err.Number 3014,无法再打开 tables.
根据我在 Internet 上找到的内容,这与 Jet table 引用有关并且很难排除故障。我遵循了我能找到的建议,我相信我在使用后已经正确地关闭了所有东西。我认为问题可能出现在合并 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
试试把"DoCmd.OutputTo"语句注释掉,看看会不会报错。我猜除了在之前的 DoCmd.OpenReport 行中打开的报告之外,此命令还打开了一份报告。
(我本来可以将其添加为评论,但我不允许)
我使用的是 DoCmd.OpenReport,因为它内置了 WHERE 子句功能。阅读 JayRO-GreyBeard 的评论后,我意识到同时使用 OpenReport 和 OutputTo 方法似乎是多余的。因此,我重写了代码,删除了 OpenReport 调用并在调用 OutputTo 之前修改了每个报告的 QueryDef。
出于某种原因,这解决了这个问题。
感谢您的帮助!
我遇到了与 3014 错误相同的问题。我正在将报告输出为 PDF,同时在屏幕上为用户显示报告(同时使用 Docmd.OpenReport 和 Docmd.OutputTo,这对于单个报告工作正常。但是,当我批处理 运行 报告和 export/display 报告。(该工具自动生成采购订单)3014 错误将发生在大约 100 份左右的报告中。
当我关闭 DoCmd.OpenReport 批量 运行 PDF 报告时。 3014 错误消失了。我已经重新测试,无法 运行 报告 1000 年代的批次没有问题。
我正在使用 VBA 和 MS Access 2010 从我们公司的数据库中编写报告。我有近 3000 名员工,我需要为每位员工写出 10 份不同的报告,然后将这 10 份报告合并到每位员工一份 pdf。然后将这些文件保存在按其工作地点排序的目录中。
我写的代码工作得很好并且完成了预期的工作除了在写出 1024 份报告后我收到一个错误。 Err.Number 3014,无法再打开 tables.
根据我在 Internet 上找到的内容,这与 Jet table 引用有关并且很难排除故障。我遵循了我能找到的建议,我相信我在使用后已经正确地关闭了所有东西。我认为问题可能出现在合并 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
试试把"DoCmd.OutputTo"语句注释掉,看看会不会报错。我猜除了在之前的 DoCmd.OpenReport 行中打开的报告之外,此命令还打开了一份报告。
(我本来可以将其添加为评论,但我不允许)
我使用的是 DoCmd.OpenReport,因为它内置了 WHERE 子句功能。阅读 JayRO-GreyBeard 的评论后,我意识到同时使用 OpenReport 和 OutputTo 方法似乎是多余的。因此,我重写了代码,删除了 OpenReport 调用并在调用 OutputTo 之前修改了每个报告的 QueryDef。
出于某种原因,这解决了这个问题。
感谢您的帮助!
我遇到了与 3014 错误相同的问题。我正在将报告输出为 PDF,同时在屏幕上为用户显示报告(同时使用 Docmd.OpenReport 和 Docmd.OutputTo,这对于单个报告工作正常。但是,当我批处理 运行 报告和 export/display 报告。(该工具自动生成采购订单)3014 错误将发生在大约 100 份左右的报告中。
当我关闭 DoCmd.OpenReport 批量 运行 PDF 报告时。 3014 错误消失了。我已经重新测试,无法 运行 报告 1000 年代的批次没有问题。