I got the following VBA code from the web a while ago:
Private Sub btnCreatePDF_Click()
Dim MyPath As String
Dim MyFilename As String
MyPath = "D:\reports\"
MyFilename = "KS1.pdf"
'Open report preview and auto-save it as a PDF
DoCmd.OpenReport "Rpt_KS1", acViewPreview
DoCmd.OutputTo acOutputReport, "", acFormatPDF, MyPath & MyFilename, False 'Change false to true here to auto-open the saved PDF
'Close the previewed report
DoCmd.Close acReport, "Rpt_KS1"
End Sub
It was for use in MS Access to create a single pdf of reports (containing up to 30 pages) and works fine for what i needed. However, i now need to split the report into the 30 or so pages and create a pdf for each of the pages. Any idea how this can be done?
I have a 'username' in the report or can add a unique ID if this helps to split them etc.
Use the 4th parameter (WhereCondition) of Docmd.OpenReport. With the WhereCondition, do exactly what you would normally do when adding a Where to your query, only don't include the word Where. This will make the report only display records that match the WhereCondition.
Retrieve your list of unique identifiers into some sort of a collection, or recordset then do a loop. This example assumes that you have them in a collection called uniqueIds and will almost definitely require some modification by you.
Dim MyPath As String
Dim MyFilename As String
MyPath = "D:\reports\"
'Loop structure may vary depending on how you obtain values
For each uniqueId in uniqueIds
MyFilename = "KS1" & uniqueId & ".pdf"
'Open report preview and auto-save it as a PDF
DoCmd.OpenReport "Rpt_KS1", acViewPreview, , "uniqueField = " & uniqueID
DoCmd.OutputTo acOutputReport, "", acFormatPDF, MyPath & MyFilename, False
'Close the previewed report
DoCmd.Close acReport, "Rpt_KS1"
Next uniqueId
Strictly speaking, this may not result in a different PDF for each page. But it will generate a different PDF for each uniqueID, which might be every page depending on your data.
Related
I've never posted before and am new to this. I'm using VBA to get a single report to save multiple PDFs. I receive an "Object missing" error message from the code I built from some of the postings here or other sites. I have tried multiple corrections, but each results in either this or a new error. The code is:
Private Sub RunErrors55COPY_Click()
On Error GoTo Err_RunErrors55_Click
Dim MyPath As String
Dim MyFilename As String
Dim uniqueID As Recordset
Dim Report_ID As Field
Dim Db As Database
MyPath = "\\test.net\files\bissvcs\Services\Errors\"
Set Db = CurrentDb()
Set uniqueID = Db.OpenRecordset("ReportIdent01")
'Loop structure may vary depending on how you obtain values
For Each uniqueID In Report_ID
MyFilename = "Bsvc Error " & Report_ID & ".pdf"
'Open report preview and auto-save it as a PDF
DoCmd.OpenReport "Report01 Error Check", acViewPreview, , "uniqueID = " & Report_ID
DoCmd.OutputTo acOutputReport, "Report01 Error Check", acFormatPDF, MyPath & MyFilename, False
'Close the previewed report
DoCmd.Close acReport, "Report01 Error Check"
Next uniqueID
Exit_RunErrors55_Click:
Exit Sub
Err_RunErrors55_Click:
MsgBox Err.Description
Resume Exit_RunErrors55_Click
End Sub
Any ideas and help would be greatly appreciated!
I'm not at all familiar with VBA scripts, but I've tried a few scripts found here and elsewhere online without a lot of luck.
Currently I have a form where a user can press an "Export Report" command button, which opens a prompt asking for an [AgencyID] (a 5 digit id number). Once the user enters an [AgencyID] a report "rptAgencyReport" is launched which displays information from query "qryAgencyReport" using the criteria "Like [AgencyID]" to query fields from many tables in a print-friendly view. From here the user can either print the report or save it as pdf or rtf.
My problem is if we want to export a copy of all our files to .rtf format we have to manually select the "Export Report" button, enter the [AgencyID], then save the outputted file. For 600-700 individual reports this takes days to complete.
What I would like to do is rather than manually entering the [AgencyID] and running each report, I would like to batch export these reports to .rtf files using the [AgencyID] as the filename. I have a query "exportAgencyID" which contains a lists of all the [AgencyID]s I need to run, but I have not found a way to pass the [AgencyID] as a variable to the report and query.
I've looked at https://support.microsoft.com/en-us/kb/209790 but I don't know how to take each record from query "exportAgencyID" and use it as the input required for the query "qyrAgencyReport".
Query "exportAgencyID"
[AgencyID]
3
36
162
194
1190
1345
. . .
Query "qryAgencyReport"
Field: AgencyID
Table: AgencyMaster
Sort:
Show: checked
Criteria: Like [AgencyID]
tldr; Report displays results of query in a printable form; query results are based on the user entered [AgencyID]. How can I set the [AgencyID] input automatically from a table or query containing all the [AgencyID]s and export a record named [AgencyID].rtf for each [AgencyID]?
Anyone able to help a non-profit save a few days of repetitive work?
The question is a bit ambiguous, but I created a simple function that might help you out
Public Sub GetAgencyID()
Dim rst As Recordset
Dim db As Database
Dim strSQL As String
set db = CurrentDb
strSQL = "SELECT exportAgencyID.AgencyID FROM exportAgencyID ORDER BY exportAgencyID"
set rst = db.OpenRecordset(strSQL)
rst.MoveFirst
Do Until rst.EOF
DoCmd.OpenReport "rptAgencyReport", acViewPreview, , "AgencyID = " & rst!AgencyID
DoCmd.OutputTo acOutputReport, "rptAgencyReport", acFormatRTF, "C:\ReportsFromAccess\AgencyID." & rst!AgencyID & ".rtf"
docmd.close acReport, "rptAgencyReport"
rst.MoveNext
loop
rst.close
set rst = nothing
strSQL = ""
End Sub
C:\ReportsFromAccess requires you to have a folder named ReportsFromAccess in your C:\ drive. You can edit that to save it to where it needs to be saved. It should create a file like AGencyID1.rtf when AgencyID =1
Thank you #juan-castiblanco for the code. I needed to make a couple tweaks to get this to work. Below is the working code.
Private Sub GetAgencyID()
Dim rst As Recordset
Dim db As Database
Dim strSQL As String
Set db = CurrentDb()
Set rst = db.OpenRecordset("SELECT [AgencyID] FROM [exportAgencyID]")
rst.MoveFirst
Do Until rst.EOF
DoCmd.OpenReport "rptAgencyReport", acViewPreview, , "AgencyID = " & rst!AgencyID
DoCmd.OutputTo acOutputReport, "rptAgencyReport", acFormatRTF, "C:\Provider Profiles 2016\" & rst!AgencyID & ".rtf"
DoCmd.Close acReport, "rptAgencyReport"
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
strSQL = ""
End Sub
Let's say I have an hundred page report in Access 2010 that includes lists of names (with some other details), grouped by a variable called NOM_RITIRO.
I would like to output the report into different PDF files, one for each value of the variable used for grouping.
I was trying to figure out how to make this code work:
Sub SplitPdf()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim Source As String
Dim SQL As String
Dim MyPath As String
Dim MyFilename As String
MyPath = "D:\Folder\"
Set db = CurrentDb
SQL = "Select NOM_RITIRO From QueryNominativi Group By NOM_RITIRO"
Set rs = db.OpenRecordset(SQL)
While Not rs.EOF
MyFilename = "TK_" & rs!NOM_RITIRO & ".pdf"
' Apply quotes as NOM_RITIRO is a string.
DoCmd.OpenReport "ElenchiNominativi", acViewPreview, , "NOM_RITIRO = '" & rs!NOM_RITIRO.Value & "'"
DoCmd.OutputTo acOutputReport, , acFormatPDF, MyPath & MyFilename, False
DoCmd.Close acReport, "ElenchiNominativi"
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
I got stuck when I try to run the DoCmd.OpenReport.
I get the message box "Enter parameter Value" like if the recordset is not passing any data
Any idea of what I did wrong?
If NOM_RITIRO is not a field in the recordsource of your report called "ElenchiNominativi" (or mis-spelled) then it will prompt you to enter a parameter value.
Similarly, if the recordsource of your report is a query that contains a fieldname not referenced in any of the tables, you will also get this prompt.
I am currently in the process of generating a report in access which, once generated, should be saved to a save location to user puts in.
Here's my block of code.
ReportName = "Appraisal_" & Trim(Str(Year)) & "_" & Me.empnr & "_" & Veilig(Me.empnr) & "_" & Format(Now(), "YYYY_MM_DD_HH_MM_SS")
DoCmd.CopyObject , ReportName , acReport, "rpt_beoordelen"
DoCmd.OpenReport ReportName , acViewPreview, , "EmployeeNr='" & Me.empnr & "' and year=" & Me.Year
DoCmd.OutputTo acOutputReport, "", acFormatPDF, , True
DoCmd.Close acReport, ReportName
This generates and displays the report with the correct values. It asks for save location. And, once given, tries to save the file to given location. It quickly flashes a printing PDF to give location window.
After this the program stops. No file can be found at the given location and the report is still opened. Debugging the application shows me that
DoCmd.Close acReport, ReportName
is never reached. I do not get a errormessage and i have no clue what is going wrong. Could anyone give me a solution to this problem?
If you are having trouble getting DoCmd.OutputTo to work with the "active object" by leaving ObjectName empty (ref: here) then you could try this:
Open the "rpt_beoordelen" report and save its Record Source query as a saved Query named "rpt_beoordelen_base_data". Create a "rpt_beoordelen_data" saved Query with some generic SQL like...
SELECT * FROM rpt_beoordelen_base_data
...then make "rpt_beoordelen_data" the Record Source for the [rpt_beoordelen] report.
Now change the code from your question to something like this:
ReportName = "Appraisal_" & Trim(Str(Year)) & "_" & Me.empnr & "_" & Veilig(Me.empnr) & "_" & Format(Now(), "YYYY_MM_DD_HH_MM_SS")
DoCmd.CopyObject , ReportName , acReport, "rpt_beoordelen"
Dim cdb As DAO.Database
Set cdb = CurrentDb
Dim qdf As DAO.QueryDef
Set qdf = cdb.QueryDefs("rpt_beoordelen_data")
qdf.SQL = "SELECT * FROM rpt_beoordelen_base_data WHERE EmployeeNr='" & Me.empnr & "' and year=" & Me.Year
Set qdf = Nothing
DoCmd.OutputTo acOutputReport, ReportName, acFormatPDF
That will change your invocation of DoCmd.OutputTo to one that does not depend on the "active object" and may yield the results you desire. (FWIW, it's the only way I've gotten this method to work for generating PDF versions of reports.)
I have two functions that will open and save two diffrent reports based on the same criteria. They are identical except for the refrences:
Function Export_MLR()
On Error GoTo Export_MLR_Err
Dim strReportName As String
DoCmd.OpenReport "Market Rate Notification Final", acViewPreview
strReportName = "S:\National Installations\Market Labor Rates\MLR_INV\MLR\" & Format (Reports![Market Rate Notification Final].Market_ID, "00") & " " & Replace(Reports![Market Rate Notification Final].Product_Code, " / ", "_") & "-" & "Market Rate Notification Final" & "_" & Format(Date, "mmddyy") & ".pdf"
DoCmd.OutputTo acOutputReport, "Market Rate Notification Final", "PDFFormat(*.pdf)", strReportName, False, , , acExportQualityScreen
DoCmd.Close acReport, "Market Rate Notification Final", acSaveNo
Export_MLR_Exit:
Exit Function
Export_MLR_Err:
MsgBox Error$
Resume Export_MLR_Exit
End Function
Then I created this function to select the data and put it into the table that the reports refrence line by line:
Function MassMarket()
On Error GoTo MassMarket_ERR
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
'this query creates my rs1 recordset'
DoCmd.SetWarnings (warningsOff)
DoCmd.OpenQuery "mass_market", acNormal, acEdit
DoCmd.SetWarnings (warningsOn)
Set db = CurrentDb()
Set rs1 = db.OpenRecordset("Mass_market_Rate_change")
Set rs2 = db.OpenRecordset("tbl_Form_Auto")
'this checks and clears any records in rs2'
If rs2.EOF = False And rs2.BOF = False Then
rs2.MoveFirst
rs2.Delete
End If
rs1.MoveFirst
'loop goes through and adds 1 line runs reports saves them and deletes line'
Do Until rs1.EOF
Set rs2 = db.OpenRecordset("tbl_Form_Auto")
rs2.AddNew
rs2![MarketID] = rs1![MarketID]
rs2![Product_ID] = rs1![Product_ID]
rs2.Update
Call Export_Invoice
Call Export_MLR
rs1.MoveNext
rs2.MoveFirst
rs2.Delete
Loop
MassMarket_Exit:
Exit Function
MassMarket_ERR:
MsgBox Error$
Resume MassMarket_Exit
End Function
Now all of this worked like a charm but it created, on average 16 .pdf files per minute and I had to create 820 .pdf files(about 50 minutes). If this is the best I can do then I will take it but would love to cut this time in half if possible. Thanks for any and all input. NR
In a comment you indicated the bulk of the time is spent in your functions which export the reports to PDF. I'm uncertain whether we can speed those up.
It seems you open a report, reference a value in that report for use as part of the PDF file name, then call the OutputTo method with the same report name to save it as PDF.
In that situation, I'm uncertain what happens "under the hood" ... whether Access opens a second instance of the report object, or is smart enough to see that you already have an instance open and just use that one instead.
As a test, try to signal Access to use the first report instance. From the online help for the ObjectName parameter of the OutputTo method:
If you want to output the active object, specify the object's type for the ObjectType argument and leave this argument blank.
So what I'm suggesting is try this in your code:
DoCmd.OutputTo acOutputReport, , "PDFFormat(*.pdf)", _
strReportName, False, , , acExportQualityScreen
If Access complains, try it with an empty string for the ObjectName parameter.
DoCmd.OutputTo acOutputReport, "", "PDFFormat(*.pdf)", _
strReportName, False, , , acExportQualityScreen
I don't know how much (or even if) this suggestion will speed up your code. But if you can't speed up those export functions somehow, my hunch is your hope to cut the overall time by half is a shaky proposition.