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
Sub PrintReportAsPDF()
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 currentdir As String
Dim pdfwriter As Object
Rem -- Get the directory of the database
currentdir = GetDatabaseFolder
Rem -- Read the info xml
Set xmldom = CreateObject("MSXML.DOMDocument")
xmldom.Load (currentdir & "\info.xml")
Rem -- Get the program id of the automation object.
progid = xmldom.SelectSingleNode("/xml/progid").Text
Rem -- Create the printer automation object
Set pdfwriter = CreateObject(progid)
Rem -- Printer specific settings
pdf_printer_name = pdfwriter.GetPrinterName
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 Sub
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 Sub
End If
Rem -- Set the printer
Application.Printer = Application.Printers(pdf_printer_index)
Rem -- Configure the PDF printer
With pdfwriter
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 Sub
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
|
bioPDF