VBA to Export Report to Multiple .PDFs

[dstaple]

Hi All,

I'm very new to VBA but have cobbled together the following code from a number of more experienced users online. I have a report called ITD Summary (Division) that has page breaks for each different BFR Name, and I'm trying to use this code to export each of these BFR Name sections of the report as individual .pdf files. The code below executes just fine, but it ends up exporting the entire report for each of the individual BFR Names rather than just the individual section of the report. Any advice? Thanks in advance!

CODE (sorry for the poor formatting)

Sub TestModule()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim baseSQL As String
Dim rptSQL As String
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("SELECT [BFR Name] FROM [BFR Names]",
dbOpenSnapshot)
Set qdf = dbs.QueryDefs("[DOM Query 2]")

baseSQL = " SELECT [DOM Query 1].Investigator, [DOM Query 1].[Fund
Code], [DOM Query 1].Revenue, [DOM Query 1].[Non Salary Exp], [DOM
Query 1].[Salary Expense], [DOM Query 1].[Earned Rev], nz([DOM Query
1]![Non Salary Exp],0)+nz([DOM Query 1]![Salary Expense],0) AS [Total
Expenses], nz([DOM Query 1]![Revenue],0)+nz([DOM Query 1]![Non Salary
Exp],0)+nz([DOM Query 1]![Salary Expense],0) AS [R/3 Balance],
IIf(nz([Earned Rev],0)-nz([Revenue],0)<=0,nz([Earned
Rev],0)-nz([Revenue],0)) AS [A/R], nz([R/3 Balance],0)+nz([A/R],0) AS
[Adjusted Balance], [DOM Query 1].[Divisions], [DOM Query 1].[Monthly
Earned Rev], [DOM Query 1].[Fund Code & Name]" & _

" FROM [DOM Query 1]"
With rst
Do Until .EOF
rptSQL = baseSQL & " And [BFR Name] = " & ![BFR Name]
qdfSQL = rptSQL
DoCmd.OutputTo acOutputReport, "ITD Summary (Division)",
acFormatPDF, "C:\Documents and Settings\dms28\Desktop\" &
![BFR Name] & ".pdf"
.MoveNext
Loop
.Close
End With
qdf.SQL = baseSQL
Set qdf = Nothing
Set rst = Nothing
Set dbs = Nothing
End Sub

 

[vbaInet]

Have a look at this thread:

http://www.access-programmers.co.uk/forums/showthread.php?t=206372&highlight=outputto

Post #10.

 

[dstaple]

Thanks for the suggestion, VbaInet . . . I took a look and may try modifying your code from that post to suit my report.

However, the code I posted here is 95% functional, the only problem being that I'm getting the full report exported for each BFR Name rather than only the page(s) of the report that belong to the individual BFR Name.

Can anyone tell me how to fix this in the existing code?

Thanks again,
Dave

 

[vbaInet]

I didn't post it to you as a suggestion. It is a solution. The code you got from wherever you got it from will NOT do what you want.

Plus you need to get rid of the Page Breaks.

 

[dstaple]

Gotcha, thanks for the help and sorry I misunderstood! I've inserted your code into the open and close events of my report and removed the page breaks. I copied and pasted the SQL from the query my report is based on, but the code isn't compiling. I'm sure I have made some kind of stupid mistake. Any thoughts? Here's the code I have in the module:

Public strRptFilter As String
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("SELECT DISTINCT [BFR Name] FROM [BFR Names] ORDER BY [BFR Name];", dbOpenSnapshot)

strRptFilter = " SELECT [DOM Query 1].Investigator, [DOM Query 1].[Fund Code], [DOM Query 1].Revenue, [DOM Query 1].[Non Salary Exp], [DOM Query 1].[Salary Expense], [DOM Query 1].[Earned Rev], nz([DOM Query 1]![Non Salary Exp],0)+nz([DOM Query 1]![Salary Expense],0) AS [Total Expenses], nz([DOM Query 1]![Revenue],0)+nz([DOM Query 1]![Non Salary Exp],0)+nz([DOM Query 1]![Salary Expense],0) AS [R/3 Balance], IIf(nz([Earned Rev],0)-nz([Revenue],0)<=0,nz([Earned Rev],0)-nz([Revenue],0)) AS [A/R], nz([R/3 Balance],0)+nz([A/R],0) AS [Adjusted Balance], [DOM Query 1].[Divisions], [DOM Query 1].[Monthly Earned Rev], [DOM Query 1].[Fund Code & Name]" & _
" FROM [DOM Query 1]"

Do While Not rst.EOF
strRptFilter = "[BFR Name] = " & Chr(34) & rst![BFR Name] & Chr(34)

DoCmd.OutputTo acOutputReport, "ITD Summary (Division)", acFormatPDF, "C:\Documents and Settings\dms28\Desktop\" & "\" & rst![GroupID] & ".pdf"
DoEvents
rst.MoveNext
Loop

rst.Close
Set rst = Nothing

 

[vbaInet]

Ok, I will need to know the exact error message and what line is highlighted.

And for future posts, you can wrap your code in Code tags to preserve the formatting. Here's how:

http://www.access-programmers.co.uk/forums/showthread.php?p=1009015#post1009015

 

[dstaple]

"Compile Error: Invalid Outside Procedure" at the Set rst line (line 3 of code) . . .


Thanks for the tip on tags . . .
dave

 

[vbaInet]

What that means is you haven't closed the function properly. There's no End Function line.

 

[dstaple]

Thanks!!! It works perfectly. I can't tell you how much time this will save me . . . many many thanks.

 

[vbaInet]

Glad it worked for you!

By the way, welcome to the forum.

 

[dstaple]

One last question for you: I have seven different reports in this same database for which I'd like to repeat this output process . . . is there any trick to this beyond copying the module seven times and altering the code to fit the different names of the reports? Thanks for all the help!

 

[vbaInet]

In the function that you created to put the code in, give it a couple of parameters:

1. SQL statement
2. The report filter string
3. The GroupID string
4. The report name
5. The path to the folder

You can then use these parameters in the code and pass the parameters to the function when you want to call it.

 

[jatsold3]

Have a look at this thread:


Post #10.

I am having an issue trying to get this code to work. Currently when it runs it will save the report named as the Field indicated in the table as directed, but it does not split out the report by separate groups. So I end up with 83 reports of 83 pages each with separate names.

I am new to setting up reports in Access so I do not if it is a coding issue or a report format issue. I forced the new pages by enlarging the Group Footer section, not by inserting page breaks.

Currently this is set to run by a click of a form button, and I have your Open and Close Report codes in place.

Private Sub Report_Open(Cancel As Integer)
If Len(strRptFilter) <> 0 Then
Me.Filter = strRptFilter
Me.FilterOn = True
End If
[U]End Sub [/U]
Private Sub Report_Close()
strRptFilter = vbNullString
End Sub

Here is my code as it is now. Any suggestions or am I missing a step in this coding?

Option Compare Database
[U]Public strRptFilter As String                                                              [/U]
Public Sub Open_Click()
Dim rst As Recordset
 
Set rst = CurrentDb.OpenRecordset("SELECT DISTINCT [Bk_Name] FROM [Bk Name] ORDER BY [Bk_Name]")
Do While Not rst.EOF
    strRptFilter = "[Bk_Name] = " & Chr(34) & rst![Bk_Name] & Chr(34)
    DoCmd.OutputTo acOutputReport, "Bk_Letter", acFormatPDF, "c:\MonTemp" & "\" & rst![Bk_Name] & ".pdf"
    DoEvents
    rst.MoveNext
Loop
rst.Close
Set rst = Nothing
End Sub

 

[McSwifty]

A cursory glance through this page let me know this appears solved.

I just wanted to post this here in case I can help anyone else in the future.
I haven't taken out table or query names, so it does need a bit of cleaning up.


This creates a separate PDF for each stock buyer where a credit has sat around for a long period. This currently goes to our Inwards Goods Supervisor who then forwards relevant data to the buyer as he sees fit.

[FONT=Calibri][SIZE=3]Public Function SetupEmailSend()[/SIZE][/FONT]
 
[FONT=Calibri][SIZE=3]Dim strFilename() As String[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]'THE EMAIL SEND ROUTINE ALLOWS FOR ARRAYS FOR THE EMAIL ADDRESSES SO YOU NEED TO BUILD UP THE LIST USING A LOOP[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim strRecip(1) As String[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim strccMail(1) As String[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim strEmailBcc(1) As String[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim strTitle As String[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim strMessageBody As String[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim fileAttach() As String  'Attachment variable matrix[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim m As Integer            ' loop variable[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim i As Integer[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim rsBuy As DAO.Recordset[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim qdfBuy As DAO.QueryDef[/SIZE][/FONT]
 
[FONT=Calibri][SIZE=3]Set qdfBuy = CurrentDb.QueryDefs("qrybuyeroverduenames")[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Set rsBuy = qdfBuy.OpenRecordset()[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]strRecip(1) = "EMAIL ADDRESS GOES HERE"[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]strccMail(1) = "" ‘ GOT TO HAVE THIS EVEN IF EMPTY[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]strEmailBcc(1) = "" ‘GOT TO HAVE THIS EVEN IF EMPTY[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]strTitle = "TITLE GOES HERE."[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]strMessageBody = "Please review at your earliest convenience."[/SIZE][/FONT]
 
[FONT=Calibri][SIZE=3]i = 1[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]With rsBuy          ‘ LIST OF BUYERS WHERE STOCK IS STILL SAT IN WAREHOUSE AFTER PRO-FORMA CREDIT PROCESSED[/SIZE][/FONT]
[SIZE=3][FONT=Calibri] .MoveLast[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] .MoveFirst[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri] If DCount("*", "[qrydatediff]") = 0 Then                            ‘MAKE SURE EMAIL ONLY SENT ONCE PER WEEK[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]     Exit Function[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] Else[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   ReDim strFilename(.RecordCount)[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]     Do While Not .EOF[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]     strFilename(i) = "C:\Overdue Pickups - " & !BuyerNam & " as of " & Format(Date, " dd-mm-yyyy ") & ".pdf"[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri]     DoCmd.OpenReport "rptoverdue", acViewPreview, , "[Buyer] = " & !Buyer, acHidden ‘HAVE FOUND YOU HAVE TO OPEN SOME REPORTS HIDDEN TO GET PDF TO EXPORT CLEAN[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]     DoCmd.OutputTo acOutputReport, "rptoverdue", acFormatPDF, strFilename(i), False, , , acExportQualityPrint[/FONT][/SIZE]
 
 
[SIZE=3][FONT=Calibri]     SendNotesMail strRecip, strccMail, strEmailBcc, strTitle & " - " & !BuyerNam, strMessageBody, strFilename(i)                ‘ATTACHED SENDNOTESMAIL BELOW – YES WE USE LOTUS NOTES FOR OUR COMPANY[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]     Kill strFilename(i)[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]     i = i + 1[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]     .MoveNext[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]     DoCmd.Close acReport, "rptoverdue", acSaveYes[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]     Loop[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] DoCmd.Close acForm, "frmReportEmail", acSaveYes[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] End If[/FONT][/SIZE]
[FONT=Calibri][SIZE=3]End With[/SIZE][/FONT]
 
[FONT=Calibri][SIZE=3]End Function[/SIZE][/FONT]
 
 
[FONT=Calibri][SIZE=3]Public Function SendNotesMail(Send() As String, SendCC() As String, SendBcc() As String, Subj As String, Mesg As String, Optional Atchmnt As String = "")[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim notesDb As Object 'The mail database[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim UserName As String 'The current users notes name[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim notesDbName As String 'THe current users notes mail database name[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim notesDoc As Object 'The mail document itself[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim notesRtf As Object 'The attachment richtextfile object[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim notesSession As Object 'The notes session[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim EmbedObj As Object 'The embedded object (Attachment)[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim attach1 As String[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim attach2 As String[/SIZE][/FONT]
 
 
[SIZE=3][FONT=Calibri] 'Start a session to notes[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] Set notesSession = CreateObject("Notes.NotesSession")[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri] 'Get the sessions username and then calculate the mail file name[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] 'You may or may not need this as for notesDBname with some systems you[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] 'can pass an empty string[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] UserName = notesSession.UserName[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] notesDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri] 'Open the mail database in notes[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] Set notesDb = notesSession.GETDATABASE("", notesDbName)[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri] If notesDb.IsOpen = False Then[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]      notesDb.OPENMAIL[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] End If[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri] 'Set up the new mail document[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] Set notesDoc = notesDb.CREATEDOCUMENT[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] notesDoc.Form = "Memo"[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] notesDoc.sendto = Send[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] notesDoc.copyto = SendCC[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] notesDoc.blindcopyto = SendBcc[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] notesDoc.Subject = Subj[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] notesDoc.body = Mesg[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] notesDoc.SAVEMESSAGEONSEND = True[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri] 'Set up the embedded object and attachment and attach it[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] If Atchmnt <> "" Then[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri] attach1 = Atchmnt[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] Set notesRtf = notesDoc.CreateRichTextItem("Attachment")[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] Set EmbedObj = notesRtf.EmbedObject(1454, "", attach1, "Attachment")[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] End If[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] 'notesDoc.CreateRichTextItem ("Attachment")[/FONT][/SIZE]
 
 
 
[SIZE=3][FONT=Calibri] 'Send the document[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] notesDoc.Send 0, Recipient[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri] 'Clean Up[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] Set notesDb = Nothing[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] Set notesDoc = Nothing[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] Set notesRtf = Nothing[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] Set notesSession = Nothing[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] Set EmbedObj = Nothing[/FONT][/SIZE]
 
[FONT=Calibri][SIZE=3]End Function[/SIZE][/FONT]

 

[Pat Hartman]

You can do the filtering part without any of the extra code. All you need to do is add a hidden field to your form. In the loop that reads the master table copy the PK to the hidden form field. Modify the RecordSource query of the report to reference that hidden form field just ahead of the OutputTo statement.

Select ... From ... Where somefield = forms!yourform!yourhiddencontrol or forms!yourform!yourhiddencotnrol Is Null;

The "Is Null" allows you to printout the entire report if you don't want to break it into sections.

 

[jatsold3]

Thank you for your suggestions. I am going to go the QueryDef route since I have used it before and need something quick to produce these. It is something I will revisit in the future just to clean up the database.

 

[jamescullis]

Hi All,

this code below worked a treat for us. Now they want me to email each PDF to each person, is this possible?

SCName = person
SCEmail = email address

Private Sub cmdSC2PDF_Click()
Dim rst As DAO.Recordset

Set rst = CurrentDb.OpenRecordset("SELECT DISTINCT [SCName] FROM [Schedule];", dbOpenSnapshot)

Do While Not rst.EOF
    strRptFilter = "[SCName] = " & Chr(34) & rst![SCNAME] & Chr(34)
    DoCmd.OutputTo acOutputReport, "fullschedulereport", acFormatPDF, "\\Server001\CompanyData\SC\temp" & "\" & rst![SCNAME] & "-" & Format(Date, "dd-mm-yyyy") & ".pdf"
    DoEvents
    rst.MoveNext
Loop

rst.Close
Set rst = Nothing
End Sub