VBA, Access, Print Report to PDF using Acrobat Distiller


I would like to automate the process of printing a MS Access report to a pdf and saving to a specific path without input from the user. Currently, I'm outputing the report to an HTML file  using the following command:

DoCmd.OutputTo acOutputReport, "", acFormatHTML, Mypath & Myfilename, True

However, the HTML format isn't as ideal as a pdf so I'd really like to figure out how to print to a pdf.  I've attached some code I've been try to get to work but keep getting a error "The expression you entered refers to an object that is closed or doesn't exist."  This error results from the following piece of the code "Set Application.Printer = Application.Printers("Acrobat PDFWriter")"

Any help would be greatly appreciated.

Option Compare Database

Private Sub cmdPrintEmp_Click()
    Dim strSave As String
    strSave = "S:\Accounting\03 IconBurger(SmashBurger)\Smashburger Database\Storelist.pdf"
     'Call the function to print it out
    If PrintReportToPDF("R_StoreList(A)", strSave) = True Then
        MsgBox "The report has been printed as " & vbCrLf & vbCrLf & _
        Replace(strSave, "\\", "\")
        MsgBox "The report FAILED to print as a PDF file!", vbCritical, "PDF Failed"
    End If
End Sub
Public Function PrintReportToPDF(strReport As String, strSave As String) As Boolean
     ' Purpose:  Print a report to a PDF file
     ' Inputs:   strReport       Name of report
     '           strSave         Name of PDF file to create
    On Error GoTo ErrHandler
     ' create the registry entry to set PDF path and filename
    'WriteRegistryEntry strSave
     ' print the report - CHECK THE PRINTER NAME IS CORRECT
    Set Application.Printer = Application.Printers("Acrobat PDFWriter")
    DoCmd.OpenReport strReport, acViewNormal
    Application.Printer = Nothing
    PrintReportToPDF = True
    Exit Function
    MsgBox Err.Description
    Resume ExitHere
End Function

Open in new window

Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Cycle through Application.Printers to be sure you're using the correct name...

Then try passing Application.Printers(x) as your printer (where x is the index of your PDF)
Sub PrinterNames()

Dim x As Integer

    For x = 0 To Application.Printers.Count - 1
        Debug.Print Application.Printers(x).DeviceName
    Next x
End Sub

Open in new window

Like this:

Set Application.Printer = Application.Printers(0)

assuming 0 is the index of the PDF printer
Tbyrd777Author Commented:
I tried using the code referenced above and for some reason it grabbed the wrong printer instead of the Adobe PDF.  However, this got me thinking and I figured out the the printer was incorrect it was previously listed as ("Acrobat PDFWriter")  and it really should have been ("Adobe PDF").  When I made this change I don't get the error anymore.

The problem is that even the the attached code works it still prompts the user the to provide the path and name of the pdf file when I want to determine the path & file name using the code to ensure everything is saved properly using the correct naming convention.

I've attached some code I use to do this exact thing in excel but I can't figure out how to convert it to work with access.
Public Function PrintSheetsToPDF( _
      ByVal SheetsToPrint As Variant, _
      ByVal PDFFilePath As String, _
      Optional ByVal ReorderSheets As Boolean _
   ) As Boolean

' Print the specified sheets to a PDF file in the order specified. Requires
' Adobe Acrobat 7.0 and a reference to Acrobat Distiller. Returns True if the
' print was successful, False otherwise.
' Syntax
' PrintSheetsToPDF(Sheets, PDFFilePath, [ReorderSheets])
' SheetsToPrint - Array of sheet names to be printed. The sheets included are
'   sorted in that order and then printed in one print job. When the printing
'   is complete the original order is restored.
' PDFFilePath - Full path to the PDF file.
' ReorderSheets - Pass True to reorder the sheets to be printed in the order
'   specified, False to not sort. optional. If omitted then False is assumed.
' Example
' Print sheets "Sheet4", "Sheet10", and "Sheet1" in that order:
'   PrintSheetsToPDF Array("Sheet4", "Sheet10", "Sheet1"), "C:\Output.PDF"
   Dim Errors As Boolean
   Dim OriginalActiveWorksheet As Object
   Dim OriginalOrderNames As Variant
   Dim Index As Long
   Dim PDFDistillerApplication As PdfDistiller
   Dim TempPFFilePathName As String
   Dim PDFLogPathName As String
   Dim Result As Long
   ' Normalize the sheets to print parameter
   If Not IsArray(SheetsToPrint) Then SheetsToPrint = Array(SheetsToPrint)
   For Index = LBound(SheetsToPrint) To UBound(SheetsToPrint)
      If TypeName(SheetsToPrint(Index)) = "Worksheet" Then SheetsToPrint(Index) = SheetsToPrint(Index).Name
   Next Index
   ' Normalize the output pdf file name
   If LCase(Right(PDFFilePath, 4)) <> ".pdf" Then PDFFilePath = PDFFilePath & ".pdf"
   ' Save the current active worksheet
   Set OriginalActiveWorksheet = ActiveSheet
   If ReorderSheets Then
      ' Save the current sheet order
      ReDim OriginalOrderNames(1 To ThisWorkbook.Sheets.Count)
      For Index = 1 To ThisWorkbook.Sheets.Count
         OriginalOrderNames(Index) = ThisWorkbook.Sheets(Index).Name
      Next Index
      ' Reorder the worksheets
      For Index = UBound(SheetsToPrint) To LBound(SheetsToPrint) Step -1
         If ThisWorkbook.Sheets(SheetsToPrint(Index)).Index > 1 Then
            ThisWorkbook.Sheets(SheetsToPrint(Index)).Move Before:=ThisWorkbook.Sheets(1)
         End If
      Next Index
   End If
   ' Print the worksheets
   TempPFFilePathName = Left(PDFFilePath, InStrRev(PDFFilePath, ".")) & "pf"
   PDFLogPathName = Left(PDFFilePath, InStrRev(PDFFilePath, ".")) & "log"
   On Error Resume Next
   If Dir("TempPFFilePathName") <> "" Then
     Kill TempPFFilePathName
    End If

   ThisWorkbook.Worksheets(SheetsToPrint).PrintOut ActivePrinter:="Adobe PDF", PrintToFile:=True, Collate:=True, PrToFilename:=TempPFFilePathName
   If Err.Number <> 0 Then
      MsgBox "To prevent this error from occurring in the future, open the Properties window for the 'Adobe PDF' printer, click the command button 'Printing Preferences', and uncheck the option 'Do not send fonts to ""Adobe PDF""'. Before the changes will take effect Excel must be quit and restarted."
      Errors = True
   End If
   On Error GoTo 0

   If ReorderSheets Then
      ' Restore the original worksheet order
      For Index = 1 To ThisWorkbook.Sheets.Count
         If ThisWorkbook.Sheets(OriginalOrderNames(Index)).Index <> Index Then
            ThisWorkbook.Sheets(OriginalOrderNames(Index)).Move Before:=ThisWorkbook.Sheets(Index)
         End If
      Next Index
   End If
   ' Restore the original active worksheet

   If Not Errors Then
      ' Convert the postscript file to .pdf
      Set PDFDistillerApplication = New PdfDistiller
      Result = PDFDistillerApplication.FileToPDF(TempPFFilePathName, PDFFilePath, "")
      On Error Resume Next
      Kill TempPFFilePathName
      If Result = 1 Then Kill PDFLogPathName
      On Error GoTo 0
   End If
   PrintSheetsToPDF = Not Errors
End Function

Open in new window


Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
I had you do the "debug.print" for the various device names so you could see for sure how the system was interpreting the printer name (I suspected the name you had was what you saw in control panel -- and not necessarily the way Application.Printers thought of it).

As far as the PDFDistillerApplication object...  I'm not familiar with it or how to tweak it.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.