Print PDF files in a specific order using shell

Hello to all,
I made a Excel vba code that sends pdf files one by one to a user specified printer and prints them out.
The code works and all the files are printed, but I still have a problem with the order of the printout files. I think this is because of the network connection and the time it takes for the printer to receive the file, add it in queue and print it.
I tried to use "application.wait now" for 4 seconds before sending the next file to the printer, but it doesn't always get the desired result.
I also added a "application. wait now" for 30 seconds when the number of printed files is a multiple of 10.
Is there a way to receive a response from the printer, that it received the command to print for file "1.pdf", so that I can tell shell to execute the next command?

Hi DJohnny,

Great question. Your problem can be solved by:
a. using Windows API calls (too much work for me) or
b. determining when the 'Spool Folder' is empty using the Dir() command

For additional information about using API calls see: https://stackoverflow.com/questions/...page-while-pri

How Windows Printing Works:
a. On most Windows computers 'Print Spooling' is automatically enabled.
b. When 'Print' is requested, print output is controlled by the Windows 'Print Spooler'.
c. Each 'Print Request' creates two files in the Spool Folder (one with .SPL extension and one with a .SHD extension).
d. The Windows 'Print Spooler' outputs to the Printer when the Printer is available.
e. If there were no 'Print Spooler':
(1) there could be a long wait before you could access the Computer when printing a long document.
(2) there could be a long wait before you could access the Computer when printing any document when using a shared printer on a network.


How the software works:
a. Each time you print two files are created in the Spool Folder (one with .SPL extension and one with a .SHD extension).
b. The Spool Folder is polled and returns the number of seconds it took for the Spool Folder to empty.
c. A return value of 0 indicates a timeout occurred.
d. A Return value of -1 indicates that the Spool folder could not be accessed (either spelled incorrectly or no 'Read Access').
e. A Return value of -2 indicates that the user DOES NOT have 'read access' to the Spool Folder.

NOTE: The Spool Folder may be protected, and an Administrator may have to give you 'Read Access' to the Spool Folder.

See the following code which is included in the attached file:

Option Explicit

Sub TestIsSpoolFolderEmpty()
  'This Prints one page from the 1st Sheet in this file then runs the IsSpoolerFolderEmpty() function.


  Dim iSpoolerEmptyReturnValue As Long
  
  Dim xTimeoutInMinutes As Double


  ThisWorkbook.Sheets(1).PrintOut

  'Set the Timeout Value for 0.25 minutes = 15 seconds
  'Determine if the Spooler is Empty or Timed Out
  xTimeoutInMinutes = 0.25
  iSpoolerEmptyReturnValue = IsSpoolerFolderEmpty(xTimeoutInMinutes)
  
  'Process the Return Value and Display a Message
  Select Case iSpoolerEmptyReturnValue
  
    Case -2
      MsgBox "IsSpoolerFolderEmpty() FAIL." & vbCrLf & vbCrLf & _
             "Do Not have Permission to access 'Print Spooler' folder." & vbCrLf & _
             "Permission may have to be granted by 'Administrator'."
    
    Case -1
      MsgBox "IsSpoolerFolderEmpty() FAIL." & vbCrLf & vbCrLf & _
             "'Print Spooler' folder DOES NOT EXIST or is spelled wrong." & vbCrLf & _
             "See Macro IsSpoolerFolderEmpty() for details."
    
    Case 0
      MsgBox "IsSpoolerFolderEmpty() FAIL." & vbCrLf & vbCrLf & _
             "Timeout of " & Format(xTimeoutInMinutes, "0.00") & " minutes (" & Format(60# * xTimeoutInMinutes, "0") & " seconds) exceeded."
    
    Case Else
      MsgBox "IsSpoolerFolderEmpty() SUCCESS." & vbCrLf & vbCrLf & _
             "Spool Folder empty after " & iSpoolerEmptyReturnValue & " seconds."
  
  End Select
  
End Sub


Function IsSpoolerFolderEmpty(xTimeoutInMinutes As Double) As Long
  'This returns the number of seconds it took for the 'Spool Folder' to Empty
  '
  'Special Return Values:
  '  0 = Timeout occurred
  ' -1 = Spool Folder spelled wrong or does not exist
  ' -2 = No 'read access' to Spool Folder
  '
  'The input value is the Timeout in Minutes:
  ' 0.0  = NO TIMEOUT
  ' 5.0  = 5 minutes Times
  ' 5.25 = 5 minutes and 15 seconds
  
  Const xSECONDS_PER_DAY As Double = 86400#
  
  Dim iCount As Long
  
  Dim bHaveEmptySpoolFolder As Boolean
  Dim bHaveTimeout As Boolean
  
  Dim xSecondsSinceMidnight As Double
  Dim xElapsedSeconds As Double
  Dim xTimeoutInSeconds As Double
  
  Dim sFileName As String
  Dim sSearchSpec As String
  Dim sSpoolFolder As String
  
  
  'Start the Timer
  xSecondsSinceMidnight = Timer
  
  'Calculate the Timeout Value in Seconds
  xTimeoutInSeconds = 60# * xTimeoutInMinutes
  
  'Create a Timeout of Several Days if the Timeout is less than or equal to ZERO
  If xTimeoutInSeconds <= 0# Then
    xTimeoutInSeconds = 100# * xSECONDS_PER_DAY
  End If

  'Get the 'Spool Folder' Path
  sSpoolFolder = "C:\Windows\System32\spool\PRINTERS"
  
  'Make sure the Folder has a trailing BackSlash
  If Right(sSpoolFolder, 1) <> "\" Then
    sSpoolFolder = sSpoolFolder & "\"
  End If
  
  'Exit with an Error if the 'Spool Folder' DOES NOT Exist
  If LJMFolderExists(sSpoolFolder) = False Then
    IsSpoolerFolderEmpty = -1
    GoTo MYEXIT
  End If
  
  'Create the Search Specification for the 'Spool Folder'
  sSearchSpec = sSpoolFolder & "*"
  
  'Test to make sure there is access to the Spool Folder
  On Error Resume Next
  sFileName = Dir(sSearchSpec)
  If Err.Number <> 0 Then
    'Set the Exit Condition
    bHaveTimeout = True
    IsSpoolerFolderEmpty = -2
  End If
  On Error GoTo 0
  
  
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Loop Until there is either a Timeout or the 'Spool Folder' is empty
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  While bHaveTimeout = False And bHaveEmptySpoolFolder = False
  
    'Get the First File Match in the Folder
    sFileName = Dir(sSearchSpec)
  
    'Get the Elapsed Time in Seconds
    'Correct for Date Rollover if needed
    xElapsedSeconds = Timer - xSecondsSinceMidnight
    If xElapsedSeconds < 0# Then
      xElapsedSeconds = xElapsedSeconds + xSECONDS_PER_DAY
    End If
    
    'Set the Exit Condition if there are NO 'Spool Files' = Success
    'Set the Exit Condition if there was Timeout = FAILURE
    'Otherwise - Wait and Repeat
    If Len(sFileName) = 0 Then
    
      'SUCCESS
      'Set the Exit Condition
      'Set the Return Value (rounded to the nearest second)
      bHaveEmptySpoolFolder = True
      IsSpoolerFolderEmpty = CLng(xElapsedSeconds)
      
      'Make sure the Value for success is at least 1 second
      If IsSpoolerFolderEmpty < 1 Then
        IsSpoolerFolderEmpty = 1
      End If
      
    ElseIf xElapsedSeconds >= xTimeoutInSeconds Then
    
      'TIMEOUT
      'Set the Exit Condition
      'Set the Return Value
      bHaveTimeout = True
      IsSpoolerFolderEmpty = 0
      
    Else
        
      'STILL WORKING - MUST ITERATE AGAIN
      'Spool File(s) still exist
      'Increment the Counter used during debugging
      'Wait one second (this value can be increased if needed)
      iCount = iCount + 1
      'Debug.Print iCount, xElapsedSeconds, xTimeoutInSeconds
      Application.Wait (Now + TimeValue("0:00:01"))
      
    End If

  Wend
  
MYEXIT:
End Function

Function LJMFolderExists(sPathAndFolderName As String) As Boolean
  'This returns TRUE if a folder exists and FALSE if a folder does NOT exist
  'This will return FALSE if the 'sPathAndFullFileName' is a file
  
  Dim iFileAttributes As Integer

  On Error Resume Next
  iFileAttributes = GetAttr(sPathAndFolderName)
  iFileAttributes = iFileAttributes And vbDirectory
  On Error GoTo 0
     
  LJMFolderExists = False
  If iFileAttributes = vbDirectory Then
    LJMFolderExists = True
  End If
  
End Function

To prevent typos from ruining days and weeks of work 'Option Explicit' is NEEDED at the top of each code module. This prevents errors caused by missspellings and FORCES every variable to be DECLARED (e.g. Dim i as Integer). http://www.cpearson.com/excel/DeclaringVariables.aspx

Lewis

Thanks for the detailed information and for the code.
Unfortunetly, because we are using Citrix (a web based Windows server app) I cannot use the VBA code because the users are restricted from accesing the Spool folder on the server. Therefore I will take a look at the API explanation and maybe from there I can figure a way to get the printer queue or spool info.
If I find the solution via API I will post it here. Maybe it whould be helpfull for others .

Hi Johnny,

Did you find anything? I am using Citrix and would like to print pdf in specific order as well. But I don't have any solution yet. Can you share with me the vba code if you find a solution? Thanks

Originally Posted by tjmax

Hi Johnny,

Did you find anything? I am using Citrix and would like to print pdf in specific order as well. But I don't have any solution yet. Can you share with me the vba code if you find a solution? Thanks

Hi Tjmax,

as a matter of fact I did find a solution. Although it works you still have to do some tweaking because of the response time between the command sending and the printer response time.
Add rep points if this helps you

Option Explicit
Declare PtrSafe Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" _
 (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long

Sub PrintPDf(fn$)
 Dim pdfEXE$, q$
 Dim ttest As String
 Dim killPdf As Long
 Dim ret
 ttest = q & pdfEXE & q & " /s /o /h /t " & q & fn & q
 pdfEXE = ExePath(fn)
 If pdfEXE = "" Then
 MsgBox "Path was not found.", vbCritical, "Oprire macro"
 Exit Sub
 End If
 
 q = """"
 'http://help.adobe.com/livedocs/acrobat_sdk/10/Acrobat10_HTMLHelp/wwhelp/wwhimpl/common/html/wwhelp.htm?context=Acrobat10_SDK_HTMLHelp&file=DevFAQ_UnderstandingSDK.22.31.html
 '/s/o/h/p/t
Shell q & pdfEXE & q & " /s /o /h /t " & q & fn & q, vbHide

1: ret = IsFileOpen(fn)
If ret = True Then
GoTo 1
End If



End Sub



Function ExePath(lpFile As String) As String
 Dim lpDirectory As String, sExePath As String, rc As Long
 lpDirectory = "\"
 sExePath = Space(255)
 rc = FindExecutable(lpFile, lpDirectory, sExePath)
 sExePath = Left$(sExePath, InStr(sExePath, Chr$(0)) - 1)
 ExePath = sExePath
End Function

Public Sub PrintareAA()
Dim wksMenu As Worksheet ' e
Dim wksTable As Worksheet ' e
Dim wksParam As Worksheet ' e
Dim wksList As Worksheet ' e
Dim wksAAPrint As Worksheet ' e

Dim objFSO As Object ' e
Dim objFolder As Object ' e
Dim objFile As Object ' e
Dim i As Integer ' e
Dim tFolder As String ' e
Dim tFilePath As String ' e
Dim tFileName As String ' e
Dim lRow As Integer ' e
Dim k As Boolean ' e
Dim fn$
Dim iFileCount As Integer
Dim printName
Dim iPrintQueue As Integer
Dim folderspec As String
Dim ret


Application.EnableEvents = False

'You should adjust the code for your macro from here

Call StartOf ' personal macro - you should delete the line
Call UnBlock ' personal macro - you should delete the line
ThisWorkbook.Activate
Set wksMenu = Sheets("Menu") ' My sheet name - you should adjust or delete the line
Set wksTable = Sheets("Data") ' My sheet name - you should adjust or delete the line
Set wksParam = Sheets("Parametri") ' My sheet name - you should adjust or delete the line
Set wksList = Sheets("Lista") ' My sheet name - you should adjust or delete the line
Set wksAAPrint = Sheets("AA de printat") ' My sheet name - you should adjust or delete the line

'setting things up so I will get the name of the files from the folder
wksAAPrint.Activate
Cells.Select
Selection.Clear

wksAAPrint.Range("A1") = "Filename"
wksAAPrint.Range("B1") = "Path"
tFolder = wksMenu.Range("C22") ' location of the folder that contains the files to print
iPrintQueue = 0
folderspec = "C:\Windows\System32\spool\PRINTERS" ' location of the printer folder (should be the same to you)

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(tFolder)
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
 'print file name
 wksAAPrint.Cells(i + 1, 1) = objFile.Name
'print file path
 wksAAPrint.Cells(i + 1, 2) = objFile.Path
 i = i + 1
Next objFile

'set printer

Call Change_Default_Printer ' this triggers another macro that asks the user to select the printer

'Print
k = False
lRow = wksAAPrint.Cells(Rows.Count, 1).End(xlUp).Row

'check spool printer - this is checking if the printer spool is empty so it can start the next job

iFileCount = 0
    For i = 2 To lRow
            tFilePath = wksAAPrint.Cells(i, 2)
            tFileName = wksAAPrint.Cells(i, 1)
            fn = tFilePath
      Application.Wait Now + TimeValue("00:00:10") 'Wait 10 sec to send to print - you can adjust this depending on how fast you network and printer are -  this requires allot of testing so I whould leave it like that
            
4:     ret = IsFileOpen(fn)
If ret = True Then
GoTo 4
End If

      'this prints the file 1 time if it has "A5" in the name, otherwise it's printing the file 2 times.
    If InStr(tFileName, "A5") > 0 Then
    PrintPDf fn

    
    iFileCount = iFileCount + 1
    Else
    PrintPDf fn


    PrintPDf fn


    iFileCount = iFileCount + 1
    End If

3:  Next



Call Block ' personal macro - you should delete the line
Call EndOf ' personal macro - you should delete the line

wksMenu.Activate ' personal macro - you should adjust/delete the line
If iFileCount > 1 Then
MsgBox "A number of " & iFileCount & " files were printed"
Else
MsgBox iFileCount & " file was printed"
End If



End Sub

Sub Change_Default_Printer()
Dim sDefaultPrinter As String
Dim sSelectedPrinter As String
sDefaultPrinter = ActivePrinter
Application.Dialogs(xlDialogPrinterSetup).Show
sSelectedPrinter = ActivePrinter
Shell "RUNDLL32 PRINTUI.DLL,PrintUIEntry /y /n " & sSelectedPrinter
End Sub