I located code on the web to print an MS access report to PDF and modified it to loop through my recordset and send a filtered report to a unique folder based on the name of the file. It's working except it skips the first folder, names and places the actual first report in the file location of the second report, and so on. Here is a cut down of the code. What am I missing? Be gentle on me - I haven't coded in quite some time, but need to get this figured out quick.

Option Compare Database
Option Explicit

Public Function PrintReportAsPDF()
Dim iPdfPrinterIndex As Integer
Dim sCurrentPrinterName As String
Dim iCurrentPrinterIndex As Integer
Dim i As Integer
Dim sCurrentDir As String
Dim oPrinterSettings As Object
Dim oPrinterUtil As Object
Dim sPrinterName As String

Dim rs As DAO.Recordset
Dim pdfName As String
Dim MyFilter As String
Dim MyFilename As String
Dim MyPath As String

Set rs = CurrentDb.openrecordset("unique_programs_distinct" )

rs.MoveFirst
Do Until rs.EOF = True
pdfName = "Report_" & rs("program") & ".pdf"
MyFilter = "Unique_Programs_Distinct.Program ='" & rs("program") & "'"
MyPath = rs("path")

DoEvents

Rem -- Create the objects to control the printer settings.
Rem -- Replace biopdf with bullzip if you have the bullzip printer installed instead
Rem -- of the biopdf printer.
Set oPrinterSettings = CreateObject("biopdf.PdfSettings")
Set oPrinterUtil = CreateObject("biopdf.PdfUtil")

Rem -- Get default printer name
sPrinterName = oPrinterUtil.DefaultPrinterName
oPrinterSettings.Printername = sPrinterName

Rem -- Get the directory of the database
sCurrentDir = MyPath

Rem -- Find the index of the printer that we want to use
iPdfPrinterIndex = -1
iCurrentPrinterIndex = -1
sCurrentPrinterName = Application.Printer.DeviceName
For i = 0 To Application.Printers.Count - 1
If Application.Printers.Item(i).DeviceName = sPrinterName Then
iPdfPrinterIndex = i
End If
If Application.Printers.Item(i).DeviceName = sCurrentPrinterName Then
iCurrentPrinterIndex = i
End If
Next

Rem -- Exit here if the pdf printer was not found
If iPdfPrinterIndex = -1 Then
MsgBox "The printer '" & sPrinterName & "' was not found on this computer."
Exit Function
End If

Rem -- Exit here if the current printer was not found
If iCurrentPrinterIndex = -1 Then
MsgBox "The current printer '" & sCurrentPrinterName & "' was not found on this computer." & _
" Without this printer the code will not be able to restore the original printer selection."
Exit Function
End If

Rem -- Set the printer
Application.Printer = Application.Printers(iPdfPrinterIndex)

Rem -- Configure the PDF printer
With oPrinterSettings
Rem -- Set the destination file name of the PDF document
.SetValue "output", MyPath & pdfName

Rem -- Control the dialogs when printing
.SetValue "ConfirmOverwrite", "no"
.SetValue "ShowSaveAS", "never"
.SetValue "ShowSettings", "never"
.SetValue "ShowPDF", "no"

Rem -- Set document properties
.SetValue "Target", "printer"
.SetValue "Title", "Program Review"
.SetValue "Subject", "Report generated at " & Now

Rem -- Display page thumbs when the document is opened
.SetValue "UseThumbs", "yes"

Rem -- Set the zoom factor to 50%
.SetValue "Zoom", "75"

Rem -- Place a stamp in the lower right corner
.SetValue "WatermarkText", "DRAFT"
.SetValue "WatermarkVerticalPosition", "bottom"
.SetValue "WatermarkHorizontalPosition", "right"
.SetValue "WatermarkVerticalAdjustment", "3"
.SetValue "WatermarkHorizontalAdjustment", "1"
.SetValue "WatermarkRotation", "90"
.SetValue "WatermarkColor", "#ff0000"
.SetValue "WatermarkOutlineWidth", "1"

Rem -- Write the settings to the runonce.ini file
.WriteSettings True
End With

Rem -- Run the report
DoCmd.OpenReport "THE_WHOLE_SHABANG", , , MyFilter, acHidden


rs.MoveNext
Loop
rs.Close

End Function

Hello sdc,

I saw your post here and though I can't see the records in the database, I do see something interesting. Notice the "MyPath" variable in your code, which sets the location for the output path. Your code says:


Anyway, from this code, it looks like you are getting the "folder path" from the "path" field in the Recordset, as shown in your code:

But you are getting the name of the PDF file from the "program" field in the recordset, in the code:

So, definitely pay close attention to these pieces when trying to debug this problem. A couple of things I would check:

1. How is the "unique_programs_distinct" Recordset created?
2. Did you check the "unique_programs_distinct" Recordset to make sure that the Folder Path and the File Names match up correctly?

Otherwise, this code would seem to do what you say it should, though I don't have any access to the data directly to see the actual output. Those would be my thoughts about where to look to solve the problem, so I hope that is helpful! And, let me know if there is anything else I can do to help...

Good luck,

Geoffrey L. Griffith
http://www.ImagineThought.com

Wrox Author of:
Access 2010 24-Hour Trainer
Access 2010 Programmer's Reference
Access 2007 VBA Programmer's Reference

The table unique_program_distinct includes a program variable (program name) and a path variable (where to put the program). The path variable was built using the program variable (C/.../program/) and it is the correct path. The problem seems to be a timing issue in the loop, but I can't see where it breaks down. I found a different solution to get the immediate need taken care of, but I definitely want to revisit this in the future to figure out how the loop is printing program 1 report, but naming and sending it to the locaton for program 2. Thanks for your input.

Hello sdc,

Glad to hear that you at least have a good workaround to the problem! I'll try to play around with the code if I have time and see what happens for me, now that I know a little more about the data. And please let me know if you ever figure out the original issue, I'd love to know the issue!

Good luck,

Geoffrey L. Griffith
http://www.ImagineThought.com

Wrox Author of:
Access 2010 24-Hour Trainer
Access 2010 Programmer's Reference
Access 2007 VBA Programmer's Reference