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.

Example Source Files

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

    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 = GetDatabaseFolder

    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", GetDatabaseFolder & "\out\example.pdf"

        Rem -- Control the dialogs when printing
        .SetValue "ConfirmOverwrite", "yes"
        .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"

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

    Rem -- Run the report
    DoCmd.OpenReport "Product Report"
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