?
Solved

PDF creator crashes when a bulk of Ms Access reports is printed in PDF format

Posted on 2009-05-20
5
Medium Priority
?
788 Views
Last Modified: 2013-11-27
Dear Experts,

I build a scheduler which sends a PDF report with checkresults to certain receipiants.
The scheduler runs every minute and creates a report for all the tasks (a task consists of one or multiple checks) which are marked as SendReport once they have been completed. I use the code as pasted below.
In some cases there are quite a few reports which need to be generated (for example 25) in one run.
It looks like PDFCreator (I installed it correctly and made the references) cannot keep up with this amount of reports, or is unable to close correctly after the PDF reports are generated.
In the upper left corner a popup 'seems' to beopening and closing very quickly saying (if i can read it correctly) that the application is in use by an other application and for this reason cannot be closed (since the popup appears and disappears very quickly I cannot read it exactly). When I stop PDFCreator using the taskmanager, the vb code drops an error and sends me to the line :   .cClose (In Public Sub PrintRep).
Anyone any idea on how I can solve this issue?

Thanks in advance,
Johan



'Code used in sub for calling function ProcessCompled
 
If varRunStatusMan <> "STOPPED" Then
    'Verwerken afgeronde taken
    ProcessCompleted
    'Start executing schedule
    If varmodus = "CONSOLE_MODE" Then
        PopulateManQueue (1)
        'Check Standaard Reminders
        CheckReminders
    End If
    'Verversen Queue en taak scherm
    RefreshTasks
End If
 
'' Function ProcessCompleted
 
Public Sub ProcessCompleted()
 
On Error GoTo errorhandler
 
Dim db As Database
Dim rs As Recordset
Dim intQID As Integer
Dim blnSendReport As Boolean
Dim varTaskName As Variant
blnSendReport = False
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT * FROM STAT_Queue_Man WHERE Q_Status <> 'OPEN' AND Q_Status <> 'EXPIRED' AND Q_Status <> 'PENDING';", dbOpenDynaset, dbSeeChanges)
Do While Not rs.EOF
    Dim rs2 As Recordset
    Set rs2 = db.OpenRecordset("SELECT * FROM STAT_ManTask_SubENV WHERE Scheduler_ID & 'L' = '" & rs.Fields("Q_Reference") & "' & 'L';", dbOpenDynaset, dbSeeChanges)
    Do While Not rs2.EOF
        blnSendReport = Nz(rs2.Fields("SendRep"), 0)
        If blnSendReport = True Then
            Dim intRecepCount As Integer
            intRecepCount = DCount("Contact_ID", "STAT_ManTask_SubENV_SR", "Scheduler_ENVID & 'L' = '" & rs2.Fields("Scheduler_ENVID") & "' & 'L'")
            If intRecepCount = 0 Then
                blnSendReport = False
            End If
            Dim intCheckCount As Integer
            intCheckCount = DCount("Scheduler_Sub_ID", "STAT_ManTask_SubTasks", "Scheduler_ID & 'L' = '" & rs.Fields("Q_Reference") & "' & 'L' AND Scheduler_Sub_InDCRep = True")
            If intCheckCount = 0 Then
                blnSendReport = False
            End If
        End If
 
        If blnSendReport = True Then
            Dim stReference As String
            Dim PDFLinkCriteria As String
            Dim PDFTempPath As String
            Dim PDFFileName As String
            Dim intEnvID As Integer
            Dim intCompID As Integer
            Dim intDepID As Integer
            Dim stCompName As String
            Dim stDepName As String
            Dim stAttachment As String
            stReference = Format(Now, "YYYYMMDDHHMMSS") & CurrentUSerID
            intEnvID = rs2.Fields("ENV_ID")
            intCompID = DLookup("Comp_ID", "STAT_Component_ENV", "ENV_ID & 'L' = '" & intEnvID & "' & 'L'")
            intDepID = DLookup("DEP_ID", "STAT_Component", "Comp_ID & 'L' = '" & intCompID & "' & 'L'")
            stCompName = DLookup("Comp_Name", "STAT_Component", "Comp_ID & 'L' = '" & intCompID & "' & 'L'")
            stDepName = DLookup("Dep_Name", "STAT_Customer_Department", "Dep_ID & 'L' = '" & intDepID & "' & 'L'")
            PDFLinkCriteria = "Q_ID & 'L'= '" & rs.Fields("Q_ID") & "' & 'L' And Time_Env & 'L'= '" & rs2.Fields("ENV_ID") & "' & 'L'"
            PDFTempPath = DLookup("Param_StringValue", "ALG_Parameter_LOC", "Param_Name = 'PDF_FILEPATH'")
            CheckFilePath (PDFTempPath)
            PDFFileName = stDepName & "_" & stCompName & "_" & stReference
            PrintRep "REP_STDReport", PDFTempPath, PDFLinkCriteria, PDFFileName
               
            stAttachment = PDFTempPath & PDFFileName & ".pdf"
            '--------------------------------------------------
            'Code for sending email
            '--------------------------------------------------
            '......................
        End If
        rs2.MoveNext
    Loop
    rs2.Close
    Set rs2 = Nothing
    varTaskName = DLookup("Scheduler_Name", "STAT_ManTask", "Scheduler_ID & 'L' = '" & rs.Fields("Q_Reference") & "' & 'L'")
    CurrentDb.Execute ("Insert into STAT_Queue_Log_Man (Q_ID, Q_TaskName, Q_Reference, Q_Time, Q_Timestamp, Q_Status, Q_FailReason) VALUES (" _
                        & "'" & rs.Fields("Q_ID") & "', '" & varTaskName & "', '" & rs.Fields("Q_Reference") & "', '" & Now() & "', '" & Now() & "', '" & rs.Fields("Q_Status") & "', 'Task Removed from Queue');"), dbSeeChanges
    rs.MoveNext
Loop
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
CurrentDb.Execute ("DELETE FROM STAT_QUEUE_MAN Where Q_Status <> 'OPEN' AND Q_Status <> 'EXPIRED' AND Q_Status <> 'PENDING';"), dbSeeChanges
Exit Sub
 
errorhandler:
errordesc = "Application encountered an Error while trying to execute Public Sub ProcessCompleted [ProcessCompleted]"
Call ErrorLogging(errordesc, "ProcessCompleted", Err.Number, Err.Description)
MsgBox (errordesc), vbCritical + vbOKOnly, "Scheduler Admin"
Exit Sub
 
End Sub
 
'PrintRep function as found on the internet (modified a little so I can send some more parameters to the Public Sub)
 
Public Sub PrintRep(RepName As String, RepTarget As String, RepLinkCriteria As String, RepOutputName As String)
    Dim PDFCreator1 As PDFCreator.clsPDFCreator, DefaultPrinter As String, c As Long, OutputFilename As String
    Set PDFCreator1 = New clsPDFCreator
    With PDFCreator1
        .cStart "/NoProcessingAtStartup"
        .cOption("UseAutosave") = 1
        .cOption("UseAutosaveDirectory") = 1
        .cOption("AutosaveDirectory") = RepTarget
        .cOption("AutosaveFilename") = RepOutputName
        .cOption("AutosaveFormat") = 0                            ' 0 = PDF
        DefaultPrinter = .cDefaultPrinter
        .cDefaultPrinter = "PDFCreator"
        .cClearCache
        DoCmd.OpenReport RepName, acViewNormal, , RepLinkCriteria
        .cPrinterStop = False
    End With
 
    c = 0
 
    Do While (PDFCreator1.cOutputFilename = "") And (c < (maxTime * 1000 / sleepTime))
        c = c + 1
        Sleep 500
    Loop
 
    OutputFilename = PDFCreator1.cOutputFilename
 
    With PDFCreator1
        .cDefaultPrinter = DefaultPrinter
        Sleep 500
        .cClose
    End With
    
    Sleep 5000 ' Wait until PDFCreator is removed from memory
 
    If OutputFilename = "" Then
        MsgBox "Creating pdf file." & vbCrLf & vbCrLf & _
        "An error is occured: Time is up!", vbExclamation + vbSystemModal
    End If
End Sub

Open in new window

0
Comment
Question by:jrameuwissen
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 2
5 Comments
 
LVL 58
ID: 24431085
Johan,
Sounds to me like PDF Creator is some how not done. My guess is your problem lies in this section of the code of PrintRep():
c = 0

Do While (PDFCreator1.cOutputFilename = "") And (c < (maxTime * 1000 / sleepTime))
c = c + 1
Sleep 500
Loop

OutputFilename = PDFCreator1.cOutputFilename

With PDFCreator1
.cDefaultPrinter = DefaultPrinter
Sleep 500
.cClose
End With

Sleep 5000 ' Wait until PDFCreator is removed from memory
especially the last line, which is a fixed period. Depending on the load on the machine, things may or may not be happening as quickly as you think.
My suggestion would be to increase that last wait and test. If it doesn't seem to make a difference, then work your way back through the code looking at each of the waits.
Also look at the code and try and figure out if there is a better method of waiting. Always try and check for a specific condition rather then just waiting a set period.
last, from your description of the popup, it sounds like your getting back to PrintRep() before the last task has actually finished. Again, sounds like your trying to proceed before the last operation is really complete.
HTH,
JimD.

0
 
LVL 1

Author Comment

by:jrameuwissen
ID: 24439442
Thanks JimD.
I'll try your suggestions and let you know the results.

Regards, Johan
0
 
LVL 58

Accepted Solution

by:
Jim Dettman (Microsoft MVP/ EE MVE) earned 2000 total points
ID: 24440197
One other thing; you didn't post the sleep function, so I don't know how that's being done, but make sure at some point your issuing a DoEvents to allow the OS to catch up on tasks for other apps.
JimD.
0
 
LVL 1

Author Comment

by:jrameuwissen
ID: 24449915
JimD,

This is all I can find regarding the sleep function...
I'm working on your suggestions.

Regards, Johan

Option Compare Database
Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const maxTime = 10    ' in seconds
Private Const sleepTime = 250 ' in milliseconds
0
 
LVL 1

Author Closing Comment

by:jrameuwissen
ID: 31583407
JimD,

I think I found the solution. I replaced the Sleep with a piece of DoEvents code (see below).
In this case I count the printjobs and wait until there are none left.  Then the code continues.
The code does not crash anymore and all reports are printed to PDF.
Once again thanks for your help.

Regards, Johan

    OutputFilename = PDFCreator1.cOutputFilename

    With PDFCreator1
        .cDefaultPrinter = DefaultPrinter
        Do Until .cCountOfPrintjobs = 0
            DoEvents
        Loop
        .cClose
    End With
   
    Sleep 5000 ' Wait until PDFCreator is removed from memory
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The Windows Phone Theme Colours is a tight, powerful, and well balanced palette. This tiny Access application makes it a snap to select and pick a value. And it doubles as an intro to implementing WithEvents, one of Access' hidden gems.
If you need a simple but flexible process for maintaining an audit trail of who created, edited, or deleted data from a table, or multiple tables, and you can do all of your work from within a form, this simple Audit Log will work for you.
In Microsoft Access, when working with VBA, learn some techniques for writing readable and easily maintained code.
With Microsoft Access, learn how to start a database in different ways and produce different start-up actions allowing you to use a single database to perform multiple tasks. Specify a start-up form through options: Specify an Autoexec macro: Us…
Suggested Courses

752 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question