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.

First, the 7-PDF Printer is determined and set as the default printer, then the Access report is printed in PDF format. This user-defined settings are set to render, among other things, a watermark text in the PDF report. Afterwards, the PDF output takes place and the printer originally defined as default printer is set as standard again.

  1. Option Compare Database
  2. Option Explicit
  3.  
  4. Sub PrintReportAsPDF()
  5.     Dim pdf_printer_name As String
  6.     Dim pdf_printer_index As Integer
  7.     Dim current_printer_name As String
  8.     Dim current_printer_index As Integer
  9.     Dim i As Integer
  10.     Dim progid As String
  11.     Dim xmldom As Object
  12.     Dim currentdir As String
  13.     Dim pdfwriter As Object
  14.    
  15.     Rem -- Get the directory of the database
  16.     currentdir = GetDatabaseFolder
  17.    
  18.     Rem -- Read the info xml
  19.     Set xmldom = CreateObject("MSXML.DOMDocument")
  20.     xmldom.Load (currentdir & "\info.xml")
  21.    
  22.     Rem -- Get the program id of the automation object.
  23.     progid = xmldom.SelectSingleNode("/xml/progid").Text
  24.  
  25.     Rem -- Create the printer automation object
  26.     Set pdfwriter = CreateObject(progid)
  27.  
  28.     Rem -- Printer specific settings
  29.     pdf_printer_name = pdfwriter.GetPrinterName
  30.    
  31.     Rem -- Find the index of the printer that we want to use
  32.     pdf_printer_index = -1
  33.     current_printer_index = -1
  34.     current_printer_name = Application.Printer.DeviceName
  35.     For i = 0 To Application.Printers.Count - 1
  36.         If Application.Printers.Item(i).DeviceName = pdf_printer_name Then
  37.             pdf_printer_index = i
  38.         End If
  39.         If Application.Printers.Item(i).DeviceName = current_printer_name Then
  40.             current_printer_index = i
  41.         End If
  42.     Next
  43.    
  44.     Rem -- Exit here if the pdf printer was not found
  45.     If pdf_printer_index = -1 Then
  46.         MsgBox "The printer '" & pdf_printer_name & "' was not found on this computer."
  47.         Exit Sub
  48.     End If
  49.    
  50.     Rem -- Exit here if the current printer was not found
  51.     If current_printer_index = -1 Then
  52.         MsgBox "The current printer '" & current_printer_name & "' was not found on this computer." & _
  53.             " Without this printer the code will not be able to restore the original printer selection."
  54.         Exit Sub
  55.     End If
  56.    
  57.     Rem -- Set the printer
  58.     Application.Printer = Application.Printers(pdf_printer_index)
  59.    
  60.     Rem -- Configure the PDF printer
  61.     With pdfwriter
  62.         Rem -- Set the destination file name of the PDF document
  63.         .SetValue "output", GetDatabaseFolder & "\out\example.pdf"
  64.        
  65.         Rem -- Control the dialogs when printing
  66.         .SetValue "ConfirmOverwrite", "yes"
  67.         .SetValue "ShowSaveAS", "never"
  68.         .SetValue "ShowSettings", "never"
  69.         .SetValue "ShowPDF", "yes"
  70.        
  71.         Rem -- Set document properties
  72.         .SetValue "Target", "printer"
  73.         .SetValue "Title", "Access PDF Example"
  74.         .SetValue "Subject", "Report generated at " & Now
  75.        
  76.         Rem -- Display page thumbs when the document is opened
  77.         .SetValue "UseThumbs", "yes"
  78.        
  79.         Rem -- Set the zoom factor to 50%
  80.         .SetValue "Zoom", "50"
  81.        
  82.         Rem -- Place a stamp in the lower right corner
  83.         .SetValue "WatermarkText", "ACCESS DEMO"
  84.         .SetValue "WatermarkVerticalPosition", "bottom"
  85.         .SetValue "WatermarkHorizontalPosition", "right"
  86.         .SetValue "WatermarkVerticalAdjustment", "3"
  87.         .SetValue "WatermarkHorizontalAdjustment", "1"
  88.         .SetValue "WatermarkRotation", "90"
  89.         .SetValue "WatermarkColor", "#ff0000"
  90.         .SetValue "WatermarkOutlineWidth", "1"
  91.        
  92.         Rem -- Write the settings to the runonce.ini file
  93.         .WriteSettings True
  94.     End With
  95.    
  96.     Rem -- Run the report
  97.     DoCmd.OpenReport "Product Report"
  98. End Sub
  99.  
  100. Function GetDatabaseFolder() As String
  101.     Dim retv As String
  102.     Dim p As Integer
  103.    
  104.     retv = Application.CurrentDb.Name
  105.     p = InStrRev(retv, "\")
  106.     If p > 0 Then
  107.         retv = Left(retv, p)
  108.         If Right(retv, 1) = "\" Then retv = Left(retv, Len(retv) - 1)
  109.     Else
  110.         Err.Raise 1000, , "Unable to determine database folder"
  111.     End If
  112.     GetDatabaseFolder = retv
  113. End Function
  114.  

Downloads

Attachment Size
Example file 63.97 KB

LiveZilla Live Chat Software
Top