Klos, Susan
Susan.Klos at fldoe.org
Thu Jun 17 12:37:27 CDT 2010
I have been using this code in my Access 2003 database for a couple of
years now and though it "works" it hangs sometimes and I have not been
able to troubleshoot where and why. So...I do a work-around. I reset
the group number for "I" and start it again. It is not consistent as to
when it hangs. Sometimes it will print 20 PDF files before I have to
reset it. As you can see, I did not write this code - I downloaded it
from the internet. I wouldn't worry about it except that I am retiring
before this database is used again and I have to make the database
user-friendly as the person taking over my position does not know Access
very well. I appreciate any help you can give me. TIA.
Sub PrintAccessReportToPDF_Early()
'Author : Ken Puls ( www.excelguru.ca)
'Macro Purpose: Print to PDF file using PDFCreator
' (Download from http://sourceforge.net/projects/pdfcreator/ )
' Designed for early bind, set reference to PDFCreator
Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String
Dim sPrinterName As String
Dim sReportName As String
Dim lPrinters As Long
Dim lPrinterCurrent As Long
Dim lPrinterPDF As Long
Dim lprinterAPDF As Long
Dim prtDefault As Printer
Dim i As Variant
'Dim distnum As Variant
Dim pausetime, start
Dim distnum As String
'/// Change the report and output file name here! ///
i = 17
Do Until i = 76
' If Len(i) < 1 Then
' distnum = "0" & i
' Else
' distnum = i
' End If
distnum = DLookup("District", "SchoolTypesReport_Final", "Dist =" &
i)
sReportName = distnum
sPDFName = sReportName & ".pdf"
sPDFPath = Application.CurrentProject.Path & "\DistrictReports\"
'Resolve index number of printers to allow changing and preserving
sPrinterName = Application.Printer.DeviceName
On Error Resume Next
For lPrinters = 0 To Application.Printers.Count
Set Application.Printer = Application.Printers(lPrinters)
Set prtDefault = Application.Printer
Select Case prtDefault.DeviceName
Case Is = sPrinterName
lPrinterCurrent = lPrinters
Case Is = "Adobe PDF"
lprinterAPDF = lPrinters
Case Is = "PDFCreator"
lPrinterPDF = lPrinters
Case Else
'do nothing
End Select
Next lPrinters
On Error GoTo 0
'Change the default printer
Set Application.Printer = Application.Printers(lPrinterPDF)
Set prtDefault = Application.Printer
'Start PDF Creator
Set pdfjob = New PDFCreator.clsPDFCreator
With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With
'Print the document to PDF
DoCmd.OpenReport "rptSGTypeAssignments", acViewPreview, "", "dist="
& i, acWindowNormal
'MsgBox "Report number is " & i
DoCmd.OpenReport "rptSGTypeAssignments", acViewNormal, "", "dist=" &
i, acWindowNormal
'Wait until the print job has entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 1
If pdfjob.cCountOfPrintjobs = 1 Then
DoEvents
End If
Loop
pdfjob.cPrinterStop = False
'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
If pdfjob.cCountOfPrintjobs = 0 Then
DoEvents
End If
'I am not sure this helps but I was finding that when I
stepped through the code several times
'it would hang up in this loop. It still hangs up, but not
as often.
pausetime = 5 ' Set duration in seconds
start = Timer ' Set start time.
Do While Timer < start + pausetime
DoEvents ' Yield to other processes.
Loop
Loop
pdfjob.cClose
DoCmd.Close acReport, "rptSGTypeAssignments", acSaveNo
'Reset the (original) default printer and release PDF Creator
Set Application.Printer = Application.Printers(0)
Set pdfjob = Nothing
i = i + 1
Loop
End Sub
Susan Klos
Senior Database Analyst
Florida Department of Education
Evaluation and Reporting Office
Phone: 850.245.0708
Fax: 850.245-0710
email: susan.klos at fldoe.org <mailto:susan.klos at fldoe.org>