Create a PDF Document using Microsoft Access

This example will show you how to turn the output of a Microsoft Access report into a PDF document. The example files includes an Access database file with code listed below.

It will also show you how to make Microsoft Access set the name of the print job in the spooler queue. This is used to match the print job with a specific runonce file. That way you can handle concurrency problems where PDF printer configurations could otherwise get mixed up.

Example Source Files

Option Compare Database
Option Explicit

Public Function GetUniqueJobId() As String
    Rem -- I know this is not bullit proof but good enough for the example
    GetUniqueJobId = Timer
End Function

Public Function PrintReportAsPDF()
    Const REPORT_NAME = "Product Report"
    
    Dim pdf_printer_name As String
    Dim pdf_printer_index As Integer
    Dim current_printer_name As String
    Dim current_printer_index As Integer
    Dim i As Integer
    Dim progid As String
    Dim xmldom As Object
    Dim pdfSettings As Object
    Dim pdfUtil As Object
    Dim jobid As String
    Dim rpt As Report
    Dim printjob_name As String
    Dim fn As String
    
    DoEvents
    
    Rem -- Create the printer automation object
    Set pdfSettings = CreateObject("biopdf.PdfSettings")
    Set pdfUtil = CreateObject("biopdf.PdfUtil")

    Rem -- Printer specific settings
    pdf_printer_name = pdfUtil.DefaultPrinterName
    
    Rem -- Find the index of the printer that we want to use
    pdf_printer_index = -1
    current_printer_index = -1
    current_printer_name = Application.Printer.DeviceName
    For i = 0 To Application.Printers.Count - 1
        If Application.Printers.Item(i).DeviceName = pdf_printer_name Then
            pdf_printer_index = i
        End If
        If Application.Printers.Item(i).DeviceName = current_printer_name Then
            current_printer_index = i
        End If
    Next
    
    Rem -- Exit here if the pdf printer was not found
    If pdf_printer_index = -1 Then
        MsgBox "The printer '" & pdf_printer_name & "' was not found on this computer."
        Exit Function
    End If
    
    Rem -- Exit here if the current printer was not found
    If current_printer_index = -1 Then
        MsgBox "The current printer '" & current_printer_name & "' 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 -- Create a job id for the print job to make a runonce file that will only match this print job.
    Rem -- This will handle the situation where multiple processes running in the same user context produces print jobs.
    Rem -- It will make sure that the settings are used for the correct print job.
    jobid = GetUniqueJobId
    printjob_name = REPORT_NAME & " " & jobid
    
    Rem -- Set the printer
    Application.Printer = Application.Printers(pdf_printer_index)
    
    Rem -- Configure the PDF printer
    With pdfSettings
        .PrinterName = pdf_printer_name
        
        Rem -- Set the destination file name of the PDF document
        .SetValue "output", GetDatabaseFolder & "\out\example.pdf"
        
        Rem -- Control the dialogs when printing
        .SetValue "ConfirmOverwrite", "no"
        .SetValue "ShowSaveAS", "never"
        .SetValue "ShowSettings", "never"
        .SetValue "ShowPDF", "yes"
        
        Rem -- Set document properties
        .SetValue "Target", "printer"
        .SetValue "Title", "Access PDF Example"
        .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", "50"
        
        Rem -- Place a stamp in the lower right corner
        .SetValue "WatermarkText", "ACCESS DEMO"
        .SetValue "WatermarkVerticalPosition", "bottom"
        .SetValue "WatermarkHorizontalPosition", "right"
        .SetValue "WatermarkVerticalAdjustment", "3"
        .SetValue "WatermarkHorizontalAdjustment", "1"
        .SetValue "WatermarkRotation", "90"
        .SetValue "WatermarkColor", "#ff0000"
        .SetValue "WatermarkOutlineWidth", "1"
        .SetValue "KeyWords", jobid
        
        Rem -- Write the settings to the runonce_jobid.ini file
        Rem -- First we get the full path of the runonce matching the name of our print job
        fn = .GetSettingsFilePathEx2("runonce", printjob_name)
        Rem -- Then we save the settings to that file name
        .WriteSettingsFile fn
    End With
    
    Rem -- Run the report
    DoCmd.OpenReport REPORT_NAME, View:=acViewPreview, WindowMode:=acHidden
    Set rpt = Reports(REPORT_NAME)
    Set rpt.Printer = Application.Printers(pdf_printer_name)
    rpt.Caption = printjob_name
    DoCmd.OpenReport REPORT_NAME
    DoCmd.Close acReport, REPORT_NAME
    
    Rem -- Alternative strategy to control the name of the print job
    Rem -- This solution is to copy the report to a temp report object with a different name
    'DoCmd.OpenReport REPORT_NAME
    'DoCmd.CopyObject , printjob_name, acReport, REPORT_NAME
    'DoCmd.OpenReport printjob_name
    'DoCmd.DeleteObject acReport, printjob_name
End Function

Function GetDatabaseFolder() As String
    Dim retv As String
    Dim p As Integer
    
    retv = Application.CurrentDb.Name
    p = InStrRev(retv, "\")
    If p > 0 Then
        retv = Left(retv, p)
        If Right(retv, 1) = "\" Then retv = Left(retv, Len(retv) - 1)
    Else
        Err.Raise 1000, , "Unable to determine database folder"
    End If
    GetDatabaseFolder = retv
End Function