Solved

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

Posted on 2009-05-20
5
756 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
  • 3
  • 2
5 Comments
 
LVL 57
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 57

Accepted Solution

by:
Jim Dettman (Microsoft MVP/ EE MVE) earned 500 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

Back Up Your Microsoft Windows Server®

Back up all your Microsoft Windows Server – on-premises, in remote locations, in private and hybrid clouds. Your entire Windows Server will be backed up in one easy step with patented, block-level disk imaging. We achieve RTOs (recovery time objectives) as low as 15 seconds.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
zero pad a access form field 2 16
Delete QueryDef IF it Exists: Access VBA 5 35
Access Open Report with SQL Parameter 11 30
MS Access from Delphi 31 29
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
Phishing attempts can come in all forms, shapes and sizes. No matter how familiar you think you are with them, always remember to take extra precaution when opening an email with attachments or links.
In Microsoft Access, learn how to use Dlookup and other domain aggregate functions and one method of specifying a string value within a string. Specify the first argument, which is the expression to be returned: Specify the second argument, which …
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…

773 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