Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- VBA code that successfully converts an Access report to a PDF file.
- Instructions:
- Copy everything below the line into a module in an Access database.
- To use the code on Access 2000 and earlier, it is necessary to comment out
- three lines referring to the printer object and set the report to use PDF995
- in the report page layout dialog.
- The only way to change the printer for a report in these
- previous versions is to open the report in design mode and make the change,
- re-save the report, and then run it.
- To create your pdf file, call the function
- pdfwrite "report name","report filter(may be "")","Path to put the
- pdf"
- A new pdf file named with the name of the report will be created.
- ------------------------------------------------------
- Option Compare Database
- Option Explicit
- 'Read INI settings
- Declare Function GetPrivateProfileString Lib "kernel32" Alias _
- "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
- ByVal lpKeyName As Any, ByVal lpDefault As String, _
- ByVal lpReturnedString As String, ByVal nSize As Long, _
- ByVal lpFileName As String) As Long
- 'Write settings
- Declare Function WritePrivateProfileString Lib "kernel32" Alias _
- "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
- ByVal lpKeyName As Any, ByVal lpString As Any, _
- ByVal lpFileName As String) As Long
- Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
- Public Function FileFolderExists(strFullPath As String) As Boolean
- 'Author : Ken Puls (www.excelguru.ca)
- 'Macro Purpose: Check if a folder exists
- On Error GoTo EarlyExit
- If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True
- EarlyExit:
- On Error GoTo 0
- End Function
- Sub pdfwrite(reportname As String, destpath As String, Optional strcriteria As String)
- ' Runs an Access report to PDF995 to create a pdf file from the report.
- ' Input parameters are the name of the report within the current database,
- ' the path for the output file, and an optional criteria for the report
- ' Be sure to check that the "Generating PDF CS" setting in pdfsync.ini is set to 0
- ' when pdf995 is idle. This codes uses that as a completion flag as it seems to be
- ' the most reliable indication that PDF995 is done writing the pdf file.
- ' Note: The application.printer object is not valid in Access 2000
- ' and earlier. In that case, set the printer in the report to pdf995
- ' and comment out the references herein to the application.printer
- Dim syncfile As String, maxwaittime As Long
- Dim iniFileName As String, tmpPrinter As Printer
- Dim outputfile As String, x As Long
- Dim tmpoutputfile As String, tmpAutoLaunch As String
- ' set the location of the PDF995.ini and the pdfsync files
- iniFileName = "c:\program files (x86)\pdf995\res\pdf995.ini"
- syncfile = "c:\programdata\pdf995\res\pdfsync.ini"
- ' TEST WHETHER DESTINATION PATH EXISTS - IF NOT ALERT USER AND ABORT PRINT
- If FileFolderExists(destpath) Then
- 'MsgBox "Folder exists!"
- Else
- MsgBox "Folder does not exist! Exiting...."
- GoTo Cleanup
- End If
- ' build the output file name from the path parameter and the report name
- If Mid(destpath, Len(destpath), 1) <> "\" Then destpath = destpath & "\"
- outputfile = destpath & reportname & ".pdf"
- ' PDF995 operates asynchronously. We need to determine when it is done so we can
- ' continue. This is done by creating a file and having PDF995 delete it using the
- ' ProcessPDF parameter in its ini file which runs a command when it is complete.
- ' save current settings from the PDF995.ini file
- tmpoutputfile = ReadINIfile("PARAMETERS", "Output File", iniFileName)
- tmpAutoLaunch = ReadINIfile("PARAMETERS", "Autolaunch", iniFileName)
- ' remove previous pdf if it exists
- On Error Resume Next
- Kill outputfile
- On Error GoTo Cleanup
- ' setup new values in PDF995.ini
- x = WritePrivateProfileString("PARAMETERS", "Output File", outputfile, iniFileName)
- x = WritePrivateProfileString("PARAMETERS", "AutoLaunch", "0", iniFileName)
- ' change the default printer to PDF995
- ' if running on Access 2000 or earlier, comment out the next two lines
- Set tmpPrinter = Application.Printer
- Application.Printer = Application.Printers("PDF995")
- 'print the report
- DoCmd.OpenReport reportname, acViewNormal, , strcriteria
- ' cleanup delay to allow PDF995 to finish up. When flagfile is nolonger present, PDF995 is done.
- Sleep (10000)
- maxwaittime = 300000 'If pdf995 isn't done in 5 min, quit anyway
- Do While ReadINIfile("PARAMETERS", "Generating PDF CS", syncfile) = "1" And maxwaittime > 0
- Sleep (10000)
- maxwaittime = maxwaittime - 10000
- Loop
- ' restore the original default printer and the PDF995.ini settings
- Cleanup:
- Sleep (10000)
- x = WritePrivateProfileString("PARAMETERS", "Output File", tmpoutputfile, iniFileName)
- x = WritePrivateProfileString("PARAMETERS", "AutoLaunch", tmpAutoLaunch, iniFileName)
- x = WritePrivateProfileString("PARAMETERS", "Launch", "", iniFileName)
- On Error Resume Next
- ' if running on Access 2000 or earlier, comment out the next line
- Application.Printer = tmpPrinter
- End Sub
- Function ReadINIfile(sSection As String, sEntry As String, sFilename As String) As String
- Dim x As Long
- Dim sDefault As String
- Dim sRetBuf As String, iLenBuf As Integer
- Dim sValue As String
- 'Six arguments
- 'Explanation of arguments:
- 'sSection: ini file section (always between brackets)
- 'sEntry : word on left side of "=" sign
- 'sDefault$: value returned if function is unsuccessful
- 'sRetBuf$ : the value you're looking for will be copied to this buffer string
- 'iLenBuf% : Length in characters of the buffer string
- 'sFileName: Path to the ini file
- sDefault$ = ""
- sRetBuf$ = String$(256, 0) '256 null characters
- iLenBuf% = Len(sRetBuf$)
- x = GetPrivateProfileString(sSection, sEntry, _
- sDefault$, sRetBuf$, iLenBuf%, sFilename)
- ReadINIfile = Left$(sRetBuf$, x)
- End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement