ShellExecute print and wait (1 Viewer)

[dragnor]

Hi Experts

I have this code that is printing a report a number of times(1-10 times).

I use the code below to print the PDF file. But sometimes when i'm printing the same PDF file 6 times, only 1 or 2 of them is printed. It seems that the system does not wait for the printer to receive the printjob before sending the next one and thereby overwriting the first command/execution.

Can someone please help me so this does not happen?

for int i=1 to 10 'this "for" is just to illustrate
'Print the report (PDF file)
lRet = ShellExecute(0, "print", Application.CurrentProject.Path & "\Merge\" & rstSendAllToPrint!PDFname, "", "", SW_MINIMIZE)

WaitWhileRunning lRet
For varloop = 1 To 3000
DoEvents
Next varloop

next i

Public Sub WaitWhileRunning(lngHWnd As Long)
Dim lngExitCode As Long
Dim lnghProcess As Long

lngExitCode = STILL_ACTIVE
lnghProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, lngHWnd)
If lnghProcess > 0 Then
Do While lngExitCode = STILL_ACTIVE
Call GetExitCodeProcess(lnghProcess, lngExitCode)
DoEvents
Loop
End If
End Sub

Public Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long

 

[NigelShaw]

Hi

couldn't you just add a pause in the loop? It looks like the print could be being overwritten before the previous print is established as the vba can go like a rocket.

I had a similarish problem so I placed a pause in to give enough time for the previous action to finish and it worked like a charm

Nidge

 

[dragnor]

Hi Nidge

The pause proposal works if the network can keep up (i use a network printer). Sometimes it's small PDF files other times they can be very big, and if I pause too long the idea of my solution is ruined. So i need another way to handle this. Sorry!

 

[bulrush]

I think your "DoEvents" line is causing VBA to continue without pausing. Remove that loop with "DoEvents" and try again.

Or maybe VBA has a Sleep or Wait command.

 

[dragnor]

Finally I fund the solution but ran into a new problem :-(

First I have to make sure that Acrobat Pro and Acrobat Reader are completely shut down. If you make PDFs with Adobe in VBA, you can open and close the program with the following code:

Dim AcroExchApp As Acrobat.CAcroApp

a lot of code that makes the pdf files

and so finally:

AcroExchApp.Exit

But even if I do it so I can see Acrobat.exe is still running in my task manager under processes . And then it can't print the report.

That problem I can handle by using the following code:

Call Shell ( "taskkill / F / IM AcroRd32.exe" vbHide)

Then this works when i make pdf files:

execmd = "C: \ Program Files \ Adobe \ Acrobat 8.0 \ Reader \ AcroRd32.exe / p / h" & Sti_Til_PDF_Fil

ExecuteAndWait execmd

But now comes the fun part. The problem lies somewhere else. ExecuteAndWait gets the command line I send and it opens and print. But just like before leaving AcroRd32.exe running in processes after printing. So WaitForSingleObject that can not be completed because AcroRd32.exe is still running (See my code snippet). My best guess is to use this action:

For varloop = 1 To 15000
DoEvents
Next varloop


And then hope that it has been finished printing before I again kill the program with:

Call Shell ( "taskkill / F / IM AcroRd32.exe" vbHide)

And starts printing the next pdf file.

which makes the code work.

However, it is far from useful that I can not be sure that everything is sent to the printer unless I increase the value on my doevent loop. The system I sit with prints approx. 2000 reports that haves different sizes and it is a disaster if not everything is printed :-( So if you can help with a way to ensure that everything is sent to the printers before I kill AcroRd32.exe I must get hold of Adobe and ask them.

Public Sub ExecuteAndWait(cmdline$)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ret As Long
Dim varloop As Long

' Initialize the STARTUPINFO structure:
start.cb = Len(start)

' Start the shelled application:
ret = CreateProcessA(0&, cmdline$, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
For varloop = 1 To 15000
DoEvents
Next varloop
If ret Then
Call Shell("taskkill /F /IM AcroRd32.exe", vbHide)
' Wait for the shelled application to finish:
ret = WaitForSingleObject(proc.hProcess, INFINITE)
End If
CloseHandle (proc.hProcess)
End Sub

 

[JuriSim]

@dragnor :Have you already find a good solution for this problem?

 

[DCrake]

Have you tried using the KillProcess command. This closes all open sessions for a given application irrespective of their current state. So if you have 5 sessions of and exe in task manager it will stop all of them in one fails swoop.

David

 

[dragnor]

I'm still working on this and finally i got the correct solution

I will now explain the process:
First i make a lot of reports.
Then i merge them into one PDF file.
Some clients are to have more than one copy so i create x number of the same PDF file and merge that into one file.
So now i have one file containing all the copies of the report.
Then i start sending the PDF file to the printer.
Then i found some VB code the are looking at the print jobs on the default printer, and loops until adobe are done spooling the PDF file.
When that are done i can kill Adobe reader:
Call Shell ( "taskkill / F / IM AcroRd32.exe" vbHide)
But if i don't make a wait function before and after the kill of adobe the system freezes for 2 minutes?
The wait function only takes 1 sec and then it works like a charm!

Her is my code:
'The code that calls the process:
Dim execmd As String
execmd = Chr(34) & RegKeyRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\AcroRd32.exe\Path", 0) & "AcroRd32.exe" & Chr(34) & " /p /h " & Chr(34) & Application.CurrentProject.Path & "\Merge\" & pdfname & Chr(34)

For varloop = 1 To 2000
DoEvents
Next varloop
ExecuteAndWait execmd, pdfname


Public Sub ExecuteAndWait(cmdline$, pdfname As String)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ret As Long
Dim varloop As Long
Dim boolcheck As Boolean
Dim winHwnd As Long
Dim TWait As Date
Dim longItemsinprinter As Long
winHwnd = 0
start.cb = Len(start)
boolcheck = False
ret = CreateProcessA(0&, cmdline$, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
TWait = Time
TWait = DateAdd("s", 5, TWait)
Do Until DateAdd("s", 0, Time) >= TWait
Loop
longItemsinprinter = GetPrinterJobsCount(DefaultPrinter)
If longItemsinprinter > 0 Then
Do Until boolcheck = True
boolcheck = RefreshPrinterQueue(pdfname)
Loop
End If
For varloop = 1 To 2000
DoEvents
Next varloop
Call Shell("taskkill /F /IM AcroRd32.exe", vbHide)
For varloop = 1 To 2000
DoEvents
Next varloop
End Sub

Public Function DefaultPrinter() As String
Dim strReturn As String
Dim intReturn As Integer
strReturn = Space(255)
intReturn = GetProfileString("Windows", ByVal "device", "", strReturn, Len(strReturn))
If intReturn Then
strReturn = UCase(Left(strReturn, InStr(strReturn, ",") - 1))
End If
DefaultPrinter = strReturn
End Function

Public Function GetPrinterJobsCount(strPrinter As String) As Long
Dim hPrinter As Long
Dim lngJobsFirstJob As Long, lngJobsEnumJob As Long, lngJobsLevel As Long
Dim lngJobsNeeded As Long, lngJobsReturned As Long
Dim udtJobInfo1() As JOB_INFO_1
Dim lngJobsCount As Long
Dim lngResult As Long

lngResult = OpenPrinter(strPrinter, hPrinter, ByVal vbNullString)

lngJobsFirstJob = 0 ' zero-based position within the print queue of the first print job to enumerate

lngJobsEnumJob = 99 ' total number of print jobs to enumerate

lngJobsLevel = 1 ' Specifies whether the function should use JOB_INFO_1
' or JOB_INFO_2 structures to store data for the enumerated jobs

lngResult = EnumJobs(hPrinter, lngJobsFirstJob, lngJobsEnumJob, _
lngJobsLevel, ByVal vbNullString, 0, _
lngJobsNeeded, lngJobsReturned)

' Check out the number of jobs hypothetically will be returned
If lngJobsNeeded > 0 Then

ReDim byteJobsBuffer(lngJobsNeeded - 1)
ReDim udtJobInfo1(lngJobsNeeded - 1)

lngResult = EnumJobs(hPrinter, lngJobsFirstJob, lngJobsEnumJob, _
lngJobsLevel, byteJobsBuffer(0), lngJobsNeeded, _
lngJobsNeeded, lngJobsReturned)

' Check out the number of jobs returned
If lngJobsReturned > 0 Then
lngJobsCount = lngJobsReturned
Else
' number of jobs returned = 0 (no jobs)
lngJobsCount = 0
End If
Else
' number of jobs = 0 (no jobs)
lngJobsCount = 0
End If
lngResult = ClosePrinter(hPrinter)

GetPrinterJobsCount = lngJobsCount
End Function

Public Function RefreshPrinterQueue(pdfname As String) As Boolean
Dim hPrinter As Long
Dim lngJobsFirstJob As Long, lngJobsEnumJob As Long, lngJobsLevel As Long
Dim lngJobsNeeded As Long, lngJobsReturned As Long
Dim byteJobsBuffer() As Byte, udtJobInfo1() As JOB_INFO_1
Dim lngJobsCount As Long
Dim lngResult As Long
Dim strPrinterName As String
Dim byteBuffer(64) As Byte
Dim strDocument As String, strStatus As String, strOwnerName As String
Dim boolfilecontrol As Boolean
Dim itmX As ListItem
RefreshPrinterQueue = False
boolfilecontrol = False
strPrinterName = DefaultPrinter

lngResult = OpenPrinter(strPrinterName, hPrinter, ByVal vbNullString)

lngJobsFirstJob = 0 ' zero-based position within the print queue of the first print job to enumerate

lngJobsEnumJob = 99 ' total number of print jobs to enumerate

lngJobsLevel = 1 ' Specifies whether the function should use JOB_INFO_1
' or JOB_INFO_2 structures to store data for the enumerated jobs

lngResult = EnumJobs(hPrinter, lngJobsFirstJob, lngJobsEnumJob, _
lngJobsLevel, ByVal vbNullString, 0, _
lngJobsNeeded, lngJobsReturned)

' Check out the number of jobs hypothetically will be returned
If lngJobsNeeded > 0 Then

ReDim byteJobsBuffer(lngJobsNeeded - 1)
ReDim udtJobInfo1(lngJobsNeeded - 1)

lngResult = EnumJobs(hPrinter, lngJobsFirstJob, lngJobsEnumJob, _
lngJobsLevel, byteJobsBuffer(0), lngJobsNeeded, _
lngJobsNeeded, lngJobsReturned)

' Check out the number of jobs returned
If lngJobsReturned > 0 Then

MoveMemory udtJobInfo1(0), byteJobsBuffer(0), Len(udtJobInfo1(0)) * lngJobsReturned

For lngJobsCount = 0 To lngJobsReturned - 1
With udtJobInfo1(lngJobsCount)

' Get the document name
lngResult = lstrcpy(byteBuffer(0), ByVal .pDocument)

strDocument = StrConv(byteBuffer(), vbUnicode)
' Document name has been returned as null terminated-string
strDocument = Left$(strDocument, InStr(strDocument, vbNullChar) - 1)

' Get the document's owner name
lngResult = lstrcpy(byteBuffer(0), ByVal .pUserName)

strOwnerName = StrConv(byteBuffer(), vbUnicode)
' Document's owner name has been returned as null-terminated string
strOwnerName = Left$(strOwnerName, InStr(strOwnerName, vbNullChar) - 1)
' Translate status
strStatus = ""

strStatus = CheckStatus(strStatus, .STATUS, JOB_STATUS_DELETING, "Deleting")
strStatus = CheckStatus(strStatus, .STATUS, JOB_STATUS_ERROR, "Error")
strStatus = CheckStatus(strStatus, .STATUS, JOB_STATUS_OFFLINE, "Offline")
strStatus = CheckStatus(strStatus, .STATUS, JOB_STATUS_PAPEROUT, "Out of paper")
strStatus = CheckStatus(strStatus, .STATUS, JOB_STATUS_PAUSED, "Paused")
strStatus = CheckStatus(strStatus, .STATUS, JOB_STATUS_PRINTED, "Printed")
strStatus = CheckStatus(strStatus, .STATUS, JOB_STATUS_PRINTING, "Printing")
strStatus = CheckStatus(strStatus, .STATUS, JOB_STATUS_SPOOLING, "Spooling")
If strDocument = pdfname And (InStr(strStatus, "Spooling") > 0 Or InStr(strStatus, "Out of paper") > 0 Or InStr(strStatus, "Error") > 0) Then
RefreshPrinterQueue = False
End If
If strDocument = pdfname Then
boolfilecontrol = True
End If
End With
Next lngJobsCount
Else
' number of jobs returned = 0 (no jobs)
lngJobsCount = 0
End If
Else
' number of jobs = 0 (no jobs)
lngJobsCount = 0
RefreshPrinterQueue = True
End If
lngResult = ClosePrinter(hPrinter)
If boolfilecontrol = False Then
RefreshPrinterQueue = True
End If
End Function