Wait command for slow printer?

[iliauk]

Hi All,

I put together this sub which calls two functions I sourced online (one to get files in a folder, other to sort it alphabetically) to print all PDFs in a folder alphabetically.

However it doesn't work :D I can see whilst debugging that the order is correct and if I step through it works but I think the print queue is too slow and as it sends pdfs to print their order gets jumbled again.

I was thinking of adding a one second wait command in the loop but this doesn't seem like particularly good code?

For reference:

Sub PrintPDFFolder()
'Variable Declarations
Dim myPath As String
Dim folder As String
Dim FldrPicker As FileDialog
Dim PDFfilename As String
Dim allFiles As Variant
Dim sAdobeCommand As String
Dim x As Integer
Dim i As Integer
Dim lstFile As String
Dim myFilename As String
'Set values for constants
'Adobe Reader location (change if necessary)
Const cAdobeReaderExe As String = "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe"
'Commands for print
sAdobeCommand = " /t /h "
x = 1
 
'Get folder location
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
    .Title = "Select A Target Folder for Source"
    .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    myPath = .SelectedItems(1) & "\"
End With
 
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then Exit Sub
 
'Create array called allFiles which contains all pdfs in the folder
allFiles = GetFileList(myPath & "*.pdf")
 
'If non-empty array then sort it alphabetically
If IsArray(allFiles) Then
    Call QuickSort(allFiles, LBound(allFiles), UBound(allFiles))
End If
 
'Find first file
While lstFile <> LastFileName
    lstFile = allFiles(x)
    x = x + 1
Wend
 
'Loop through first to last file in array and print
For i = x To UBound(allFiles)
    myFilename = allFiles(i)
    Shell cAdobeReaderExe & sAdobeCommand & Chr(34) & myPath & myFilename & Chr(34), vbNormalFocus
Next i
 
End Sub
 
'Function to return all files in folder
Function GetFileList(FileSpec As String) As Variant
Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String
   
    On Error GoTo NoFilesFound
 
    FileCount = 0
    FileName = Dir(FileSpec)
    If FileName = "" Then GoTo NoFilesFound
   
'   Loop until no more matching files are found
    Do While FileName <> ""
        FileCount = FileCount + 1
        ReDim Preserve FileArray(1 To FileCount)
        FileArray(FileCount) = FileName
        FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function
 
'   Error handler
NoFilesFound:
    GetFileList = False
End Function
 
'Sub-routine to sort all elements in an array
Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)
 
  Dim pivot   As Variant
  Dim tmpSwap As Variant
  Dim tmpLow  As Long
  Dim tmpHi   As Long
 
  tmpLow = inLow
  tmpHi = inHi
 
  pivot = vArray((inLow + inHi) \ 2)
 
  While (tmpLow <= tmpHi)
 
     While (vArray(tmpLow) < pivot And tmpLow < inHi)
        tmpLow = tmpLow + 1
     Wend
 
     While (pivot < vArray(tmpHi) And tmpHi > inLow)
        tmpHi = tmpHi - 1
     Wend
 
     If (tmpLow <= tmpHi) Then
        tmpSwap = vArray(tmpLow)
        vArray(tmpLow) = vArray(tmpHi)
        vArray(tmpHi) = tmpSwap
        tmpLow = tmpLow + 1
        tmpHi = tmpHi - 1
     End If
 
  Wend
 
  If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
  If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi
 
End Sub