[AccessD] Print grouped report to PDF

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> 

 




More information about the AccessD mailing list