根据查询中的每条记录将报告打印为PDF

Question

我在Access(Q_Invoices(中有一个查询，它根据发票编号(invoice_number(有单独的记录。我还有一个链接到此查询的报告(R_Invoices_PDF(。我想做的是让VBA代码在查询中的每个记录中循环，并将记录打印为与报告分离的PDF。

我从一些网站上复制了以下代码，并试图根据自己的目的对其进行调整。它在一定程度上起作用。然而，我在它循环之前停止了它，它保存了所有记录，而不仅仅是第一条。

Private Sub cmd_GenPDFs_Click()
Dim rs                    As DAO.Recordset
Dim sFolder               As String
Dim sFile                 As String
On Error GoTo Error_Handler
sFolder = "D:DocumentsOrchestraInvoicesInvoice files"
Set rs = CurrentDb.OpenRecordset("SELECT Invoice_Number FROM Q_Invoices", dbOpenSnapshot)

With rs
.MoveFirst
Do While Not .EOF

DoCmd.OpenReport "R_Invoices_PDF", acViewPreview, , "[Invoice_Number]=" & ![Invoice_Number], acHidden
sFile = Nz(![Invoice_Number], "") & ".pdf"
sFile = sFolder & sFile
DoCmd.OutputTo acOutputReport, "R_Invoices_PDF", acFormatPDF, sFile,  acExportQualityPrint
'If you wanted to create an e-mail and include an individual report, you would do so now
DoCmd.Close acReport, "R_Invoices_PDF"
.MoveNext
Loop
End With
Application.FollowHyperlink sFolder    'Optional / Open the folder housing the files
Error_Handler_Exit:
On Error Resume Next
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
Exit Sub
Error_Handler:
If Err.Number <> 2501 Then    'Let's ignore user cancellation of this action!
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: cmd_GenPDFs_Click" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occured!"
End If
Resume Error_Handler_Exit
End Sub

Answer 1

我记得过滤报告时出现了一些问题。因此，我们使用TempVars过滤驱动报告仅返回单个发票数据的查询。

这里，Faktura的意思是发票：

Private Sub FakturaPrint( _
ByVal PrintType As CdPrintType, _
Optional ByRef FullPath As String)
Const ReportName    As String = "Faktura"
Const FileNameMask  As String = "Faktura{0}.pdf"
Const FileIdMask    As String = "kladde Job {0}"
Const CancelError   As Long = 2212  ' Cactus TimeSag cannot print the object.
Const PrintError    As Long = 2501  ' PrintOut was cancelled.

Dim Path            As String
Dim FileName        As String
Dim FileId          As String
Dim PrintCount      As Integer
Dim PrintCopy       As Integer

On Error GoTo FakturaPrint_Click_Error

' Set filter on the source query of the report.
TempVars("FakturaID").Value = Me!FaktID.Value

Select Case PrintType
Case cdPrintPreview
DoCmd.OpenReport ReportName, acViewPreview, , , acWindowNormal
Case cdPrintPrinter
PrintCount = Nz(Me!UdskFakt.Column(2), 1)
If PrintCount < 1 Then
PrintCount = 1
End If
For PrintCopy = 1 To PrintCount
DoCmd.OpenReport ReportName, acViewNormal, , , acWindowNormal
Next
Case cdPrintPdf
Path = Environ("USERPROFILE") & "Documents"
FileId = Nz(Str(Me!Faktura.Value), Replace(FileIdMask, "{0}", Me!JobID.Value))
FileName = Replace(FileNameMask, "{0}", FileId)
' Return FullPath by reference for e-mail.
FullPath = Path & FileName
DoCmd.OutputTo acOutputReport, ReportName, acFormatPDF, FullPath, False, , , acExportQualityPrint
End Select

FakturaPrint_Click_Exit:
Me!TextForClipboard.SetFocus
Exit Sub
FakturaPrint_Click_Error:
Select Case Err.Number
Case CancelError, PrintError
' Printing cancelled by user.
' Ignore.
Case Else
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FakturaPrint_Click of Sub Form_Faktura"
End Select
Resume FakturaPrint_Click_Exit

End Sub

这不是一个循环，但你可能很容易从中抽象出来。