ShellExecute print wait to finnish

Checkout this thread for code that waits until a shell'd job is finished:
http://www.experts-exchange.com/Microsoft/Development/MS_Access/Q_24044486.html
JimD.

HI JDettman

I'm using ShellExecute and not Shell, is that a problem? The Link you send me was to some code using just Shell.

I have this code to print and wait for the printjob to be delivered to the printer. What is wrong since i does not work?

When I say it does not work I mean, that it does not wait for the report to be delivered, and then sometimes it does not print all the reports.

'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
 
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

Select allOpen in new window

Yes, it's the fact that your using ShellExecute() rather then Shell(), which I didn't think about.  ShellExecute() returns a instance number and not a window handle as shell() does (they are two different things).  
I'm trying to figure out how to find the window handle for a given thread instance.  Looks like ShellExecuteEx() is one way to get it and the best given that there many be multiple copies of an app running (the other method works by using the window caption to locate the window - that would not be good if you had multiple copies of something running).
  I'm trying to put that together for you now.  I've always used shell in the past myself, so I've never run across this before, but it would be nice to be able to call ShellExecute() and not have to worry about the executable path, but still be able to wait for completion.
JimD.

Hey JimD

I'm glad that you will help me, it is very important that I find a solution. It would speed up some workload that would normally take 12 hours, but with this solution it will take about 4 hours. So thank you so much for your interest in this.

Best regards
Kim

Hi JimD

I'm able to print PDF files with this run command in windows:
AcroRd32.exe /p C:\UK\Merge\FI8263.pdf

to execute the command line in vba i'm using following code:
(see the attached code)

But in the vba code it will not work :-(

'*******************************
' Type Definition for ExecCmd
'*******************************
Private Type STARTUPINFO
  cb As Long
  lpReserved As String
  lpDesktop As String
  lpTitle As String
  dwX As Long
  dwY As Long
  dwXSize As Long
  dwYSize As Long
  dwXCountChars As Long
  dwYCountChars As Long
  dwFillAttribute As Long
  dwFlags As Long
  wShowWindow As Integer
  cbReserved2 As Integer
  lpReserved2 As Long
  hStdInput As Long
  hStdOutput As Long
  hStdError As Long
End Type
 
Private Type PROCESS_INFORMATION
  hProcess As Long
  hThread As Long
  dwProcessID As Long
  dwThreadID As Long
End Type
 
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
  hHandle As Long, ByVal dwMilliseconds As Long) As Long
 
Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
  lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
  lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
  ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
  ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
  lpStartupInfo As STARTUPINFO, lpProcessInformation As _
  PROCESS_INFORMATION) As Long
 
Private Declare Function CloseHandle Lib "kernel32" (ByVal _
  hObject As Long) As Long
 
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
 
Public Sub ExecuteAndWait(cmdline$)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ret 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)
If ret Then
    ' Wait for the shelled application to finish:
    ret = WaitForSingleObject(proc.hProcess, INFINITE)
End If
CloseHandle (proc.hProcess)
End Sub

Select allOpen in new window

I have been working on this, but did not get to spent as much time on it as I thought I would get to over the weekend.  
 What's slowing me down is that most of the examples I have found are in C++, which I really don't know all that well and I'm getting into some windows API stuff that I've never dealt with before.
But I've found a number of solutions:
1. using CreateProcess in place of ShellExecute() as you showed above.
2. using ShellExecuteEx() in place of ShellExecute().
3. Use FindExecutable() to get the path for the registered file type and then call it using Shell(), in which case the code I gave you would work.  This seems to be the most promising as all the others have some issue in one way or another.  
  I'm am the point where I was going to test it.
JimD.
 

<<But in the vba code it will not work :-(>>
  I saw that code on the mvps.org site, but it appears that it only works with .exe's rather then file (so you need to know where the executeable file is for the registered type) and it doesn't seem to take command line parameters.
  but for the now, if you can call the .EXE with a command like you gave, then simply use the code I posted at the start of this thread along with Shell().  That will work.
JimD.

so what you say is i should do it like this:
                    lRet = Shell("C:\Program Files\Adobe\Reader 8.0\Reader\AcroRd32.exe /t " & Application.CurrentProject.Path & "\Merge\" & rstSendAllToPrint!PDFname, vbHide)
                    WaitWhileRunning lRet

<<so what you say is i should do it like this:
lRet = Shell("C:\Program Files\Adobe\Reader 8.0\Reader\AcroRd32.exe /t " & Application.CurrentProject.Path & "\Merge\" & rstSendAllToPrint!PDFname, vbHide)
WaitWhileRunning lRet>>
yes, exactly. That will work. However it means you need to know the executable, which ShellExecute() avoided. With it, it was nice that you needed only to provide the file name and Windows took care of the rest.
For that reason, I will be continue to try and come up with a solution for this (or the same functionality) and also the fact that it does not appear that anyone has already come up with a good solution. That will probably be another day or two though as I did not get any time in on this this weekend as I thought I would.
One note on the above; I would pass quotes in around the path/file name in case there are embedded spaces:
lRet = Shell("C:\Program Files\Adobe\Reader 8.0\Reader\AcroRd32.exe /t " & chr$(34) & Application.CurrentProject.Path & "\Merge\" & rstSendAllToPrint!PDFname & chr$(34) , vbHide)
I would also do it like this:
strCmd = "C:\Program Files\Adobe\Reader 8.0\Reader\AcroRd32.exe /t " & chr$(34) & Application.CurrentProject.Path & "\Merge\" & rstSendAllToPrint!PDFname & chr$(34)
lRet = Shell(strCmd, vbHide)
That makes it easier to debug as you can put a breakpoint on the Shell() line and then in the debug window, do:
debug.? strCmd
which lets you look at the formatting of the entire command before execution. Makes it easy to spot mistakes that way. I do that for any external command and SQL strings I build in code.
JimD.

Hi JimD

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

Select allOpen in new window

Hi again

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!
I will add the total solution later on, but JimD you have been a great help and i will ofcause give you the points!

Best regards
Kim

Kim,
   Glad to hear you got it working and thanks for posting back with that detail for other in the future that might read this.
JimD.

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

Select allOpen in new window