Access VBA Print All Files in Folder

shieldsco
shieldsco used Ask the Experts™
on
I would like to print all files (PDFs) in a folder on my disk. I need to prompt the user for the location of the files and then print to the default printer continuously. What would the code look like?
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
View Solutions Only
Nick67
Most Valuable Expert 2014

Commented:
Lots of fun.
You need a Reference to the MS Office xx.0 Object library
That'll get you the FileDialog box

So this is the start, code to select a folder

'first we have to select the desired folder
'Declare a variable as a FileDialog object.
Dim fd As FileDialog

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
'Declare a variable to contain the path
'of each selected item. Even though the path is a String,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant

TryAgain:
'Use a With...End With block to reference the FileDialog object.
With fd
    .InitialView = msoFileDialogViewDetails ' msoFileDialogViewThumbnail
    .Title = "Folder Selector"
    '.InitialFileName = theFile
    .ButtonName = "Use this folder"
    .AllowMultiSelect = False

    'The user pressed the action button.
    If .Show = True Then
        If .SelectedItems.count = 0 Then
            MsgBox "You didn't make a valid selection.  Try again!"
            GoTo TryAgain
        End If
        msgbox .SelectedItems(1)

'...more code to actually do stuff with the files and subfolder(s) found here
    Else
        Exit Sub
    End If
End With

Open in new window


Now to flesh out this
'...more code to actually do stuff with the files and subfolder(s) found here

What will be used to handle your PDFs?
Acrobat?
Acrobat Reader?
what version(s)
Something else?
A lot depends on the answer.

VBA can't deal with PDFs straight-up.
Something external has to be invoked/shelled and so paths to the executable can become important
shieldsco

Author

Commented:
Adobe Reader XI 11.0.13 or Adobe Acrobat XI
Nick67
Most Valuable Expert 2014

Commented:
You can try this first.
Put this code in a module
Option Compare Database
Option Explicit
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
 
Public Function PrintThisDoc(formname As Long, FileName As String)
On Error Resume Next
Dim X As Long
X = ShellExecute(formname, "Print", FileName, 0&, 0&, 3)
End Function
 
Sub PrintPDF(FullPath As String)
Dim printThis
printThis = PrintThisDoc(FullPath)
End Sub

Open in new window


A little WinAPI stuff.

Be warned.
It strands an open, without document, instance of Arobat Reader when it is done, and I've never found a nice way to clean that up.

Call it like so

PrintPDF("c:\temp\somePDFILike.pdf")

If that flies, next you'll need to construct code to look at all the files and subfolders in the selected folder and, in a loop send the PDFs to PrintPDF(somefolder\somepdf.pdf)
Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Find out now!
shieldsco

Author

Commented:
compile error: By ref argument type mismatch in line printThis = PrintThisDoc(FullPath)........FullPath
Scott McDaniel (Former Microsoft Access MVP - EE MVE )Infotrakker Software
Most Valuable Expert 2012
Top Expert 2014
Commented:
I believe you can print using AcroRd32 from the command line:

"C:\Program Files (x86)\Adobe\Reader 10.0\Reader\acrord32.exe" /N /T "YourPDFfile.pdf" "Your Printer Name"

So AFTER using the code from Nick to get the directory, you could do this:

Dim file As String
Dim folder As string
folder = fd.SelectedItems(1)
file = Dir(folder & "\*.pdf")

Do Until Len(file)=0
  "C:\Program Files (x86)\Adobe\Reader 10.0\Reader\acrord32.exe" /N /T folder & "\" & file & ".pdf" "Your Printer Name"
  file = Dir
Next

Note that printing from acrord32 from the command line is officially undocumented, so use this at your own risk. I've used it in some applications with success, however. If you're leery of using that, then the only other method would be to install a 3rd party PDF printer and use that.

The switches for use with AcroRd are in this document on page 27:

http://partners.adobe.com/public/developer/en/acrobat/sdk/pdf/intro_to_sdk/DeveloperFAQ.pdf
shieldsco

Author

Commented:
Scott - compile error....syntax error

  Call Shell ("C:\Program Files (x86)\Adobe\Reader 11.0\Reader\acrord32.exe" /N /T folder & "\" & file & ".pdf" "WOC4FL-4177", vbNormalFocus)
Scott McDaniel (Former Microsoft Access MVP - EE MVE )Infotrakker Software
Most Valuable Expert 2012
Top Expert 2014

Commented:
I'd suspect there's a problem with the quotes. Without being able to test, you might try this:

  Call Shell (Chr(34) & "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\acrord32.exe" & chr(34) /N /T & chr(34) folder & "\" & file & ".pdf" & chr(34) & chr(34) "WOC4FL-4177", vbNormalFocus)

The goal is to enclose the entire call to acrord32 in double quotes, including the switches, and to also enclose the entire folder + file + pdf in double quotes, and then enclose the whole command in double quotes (up to the printer name).

If that doesn't work, then debug.print the command you're sending to shell and post it back here:

Debug.Print Chr(34) & "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\acrord32.exe" & chr(34) /N /T & chr(34) folder & "\" & file & ".pdf" & chr(34) & chr(34)
shieldsco

Author

Commented:
New compile error: next without for

 Do Until Len(file) = 0
Call Shell("C:\Program Files (x86)\Adobe\Reader 11.0\Reader\acrord32.exe" / N / T / folder & "\" & file & ".pdf" / "WOC4FL-4177", vbNormalFocus)
   file = Dir
 Next
shieldsco

Author

Commented:
Here's the complete code:
Dim fd As FileDialog

Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim vrtSelectedItem As Variant

TryAgain:
With fd
    .InitialView = msoFileDialogViewDetails ' msoFileDialogViewThumbnail
    .Title = "Folder Selector"
    '.InitialFileName = theFile
    .ButtonName = "Use this folder"
    .AllowMultiSelect = False

    'The user pressed the action button.
    If .Show = True Then
        If .SelectedItems.Count = 0 Then
            MsgBox "You didn't make a valid selection.  Try again!"
            GoTo TryAgain
        End If
        MsgBox .SelectedItems(1)

'...more code to actually do stuff with the files and subfolder(s) found here

Dim file As String
 Dim folder As String
 folder = fd.SelectedItems(1)
 file = Dir(folder & "\*.pdf")

 Do Until Len(file) = 0
Call Shell("C:\Program Files (x86)\Adobe\Reader 11.0\Reader\acrord32.exe" / N / T / folder & "\" & file & ".pdf" / "WOC4FL-4177", vbNormalFocus)
   file = Dir
Next




    Else
        Exit Sub
    End If
End With
shieldsco

Author

Commented:
Runtime error 13 type mismatch in line: Call Shell("C:\Program Files (x86)\Adobe\Reader 11.0\Reader\acrord32.exe" / N / T / folder & "\" & file & ".pdf" / "WOC4FL-4177", vbNormalFocus)

Complete Code:
Dim fd As FileDialog

Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim vrtSelectedItem As Variant

TryAgain:
With fd
    .InitialView = msoFileDialogViewDetails ' msoFileDialogViewThumbnail
    .Title = "Folder Selector"
    '.InitialFileName = theFile
    .ButtonName = "Use this folder"
    .AllowMultiSelect = False

    'The user pressed the action button.
    If .Show = True Then
        If .SelectedItems.Count = 0 Then
            MsgBox "You didn't make a valid selection.  Try again!"
            GoTo TryAgain
        End If
        MsgBox .SelectedItems(1)

'...more code to actually do stuff with the files and subfolder(s) found here

Dim file As String
 Dim folder As String
 folder = fd.SelectedItems(1)
 file = Dir(folder & "\*.pdf")
 Do Until Len(file) = 0
Call Shell("C:\Program Files (x86)\Adobe\Reader 11.0\Reader\acrord32.exe" / N / T / folder & "\" & file & ".pdf" / "WOC4FL-4177", vbNormalFocus)
   file = Dir
   For i = 1 To 100

Next

Loop


   ' Else
        Exit Sub
    End If
End With
shieldsco

Author

Commented:
Cleaned up code:

Dim fd As FileDialog

Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim vrtSelectedItem As Variant

TryAgain:
With fd
    .InitialView = msoFileDialogViewDetails ' msoFileDialogViewThumbnail
    .Title = "Folder Selector"
    '.InitialFileName = theFile
    .ButtonName = "Use this folder"
    .AllowMultiSelect = False

    'The user pressed the action button.
    If .Show = True Then
        If .SelectedItems.Count = 0 Then
            MsgBox "You didn't make a valid selection.  Try again!"
            GoTo TryAgain
        End If
        MsgBox .SelectedItems(1)

'...more code to actually do stuff with the files and subfolder(s) found here

Dim file As String
 Dim folder As String
 folder = fd.SelectedItems(1)
 file = Dir(folder & "\*.pdf")
 Do Until Len(file) = 0
Call Shell("C:\Program Files (x86)\Adobe\Reader 11.0\Reader\acrord32.exe" / N / T / folder & "\" & file & ".pdf" / "WOC4FL-4177", vbNormalFocus)
   file = Dir
   'For i = 1 To 100

'Next

Loop


   ' Else
        Exit Sub
    End If
End With
shieldsco

Author

Commented:
Anybody else have any thoughts on the posts above.... I'm under a deadline. Thanks
Jeffrey CoachmanMIS Liason
Most Valuable Expert 2012

Commented:
If you are under an immediate deadline, then just open explorer to the target folder.
Hit:  Ctrl+A  (to select all the files)
Then right-click and select Print...
shieldsco

Author

Commented:
That's not the right answer Jeffrey. I did not say immediate... I said deadline
shieldsco

Author

Commented:
Thanks anyway Jeffery
Scott McDaniel (Former Microsoft Access MVP - EE MVE )Infotrakker Software
Most Valuable Expert 2012
Top Expert 2014

Commented:
As mentioned previously, check your double quotes and such in the Shell call. You have to be sure those are in place correctly.
Jeffrey CoachmanMIS Liason
Most Valuable Expert 2012

Commented:
shieldsco,

Please, first work with Scott to get the basic "Print" code working with *One* pdf file first.

Then worry about looping...
Nick67
Most Valuable Expert 2014

Commented:
I am thoroughly buried today.
The API code as follows should compile and run
Others have supplied the Dir() looping necessary
You can Shell() and I have, but it's a pain to syntax and breaks as Acrobat Reader gets updated.

Option Compare Database
Option Explicit
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
 
Public Function PrintThisDoc(formname As Long, Filename As String)
On Error Resume Next
Dim X As Long
X = ShellExecute(formname, "Print", Filename, 0&, 0&, 3)
End Function
 
Sub PrintPDF(FullPath As String)
Dim printThis
printThis = PrintThisDoc(0, FullPath)
End Sub

Open in new window

shieldsco

Author

Commented:
Ok Scott I fixed the type mismatch and Adobe Opens with this error message : there was an error opening this document ... the specified path is invalid
shieldsco

Author

Commented:
Here's the code:

Dim fd As FileDialog

Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim vrtSelectedItem As Variant

TryAgain:
With fd
    .InitialView = msoFileDialogViewDetails ' msoFileDialogViewThumbnail
    .Title = "Folder Selector"
    '.InitialFileName = theFile
    .ButtonName = "Use this folder"
    .AllowMultiSelect = False

    'The user pressed the action button.
    If .Show = True Then
        If .SelectedItems.Count = 0 Then
            MsgBox "You didn't make a valid selection.  Try again!"
            GoTo TryAgain
        End If
        MsgBox .SelectedItems(1)

'...more code to actually do stuff with the files and subfolder(s) found here

Dim file As String
 Dim folder As String
  folder = fd.SelectedItems(1)
 file = Dir(folder & "\*.pdf")
 Do Until Len(file) = 0
   
 
Call Shell("C:\Program Files (x86)\Adobe\Reader 11.0\Reader\acrord32.exe /N /T /" & folder & "\" & file & ".pdf /WOC4FL-4177", vbNormalFocus)
   file = Dir

Loop


        Exit Sub
    End If
End With
shieldsco

Author

Commented:
Ok Scott after more work  Adobe opens with this error message : there was an error opening this document ... the file cannot be found

Here's the code:

Dim fd As FileDialog

Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim vrtSelectedItem As Variant

TryAgain:
With fd
    .InitialView = msoFileDialogViewDetails ' msoFileDialogViewThumbnail
    .Title = "Folder Selector"
    '.InitialFileName = theFile
    .ButtonName = "Use this folder"
    .AllowMultiSelect = False

    'The user pressed the action button.
    If .Show = True Then
        If .SelectedItems.Count = 0 Then
            MsgBox "You didn't make a valid selection.  Try again!"
            GoTo TryAgain
        End If
        MsgBox .SelectedItems(1)

'...more code to actually do stuff with the files and subfolder(s) found here

Dim file As String
 Dim folder As String
   folder = fd.SelectedItems(1)
 file = Dir(folder & "\*.pdf")
 Do Until Len(file) = 0
   
 
Call Shell("C:\Program Files (x86)\Adobe\Reader 11.0\Reader\acrord32.exe /N /T " & folder & "\" & file & "WOC4FL-4177", vbNormalFocus)
   file = Dir

Loop


        Exit Sub
    End If
End With
Nick67
Most Valuable Expert 2014

Commented:
Ok
Here it is with a sample
Reference  to the MS Office xx.0 Object library required
Reference to the Windows script Host Object model required

Here's the module
Option Compare Database
Option Explicit
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
 
Public Function PrintThisDoc(formname As Long, Filename As String)
On Error Resume Next
Dim X As Long
X = ShellExecute(formname, "Print", Filename, 0&, 0&, 3)
End Function
 
Sub PrintPDF(FullPath As String)
Dim printThis
printThis = PrintThisDoc(0, FullPath)
End Sub

Open in new window


Here's the command button sub

Private Sub cmdPrintThem_Click()
Dim fd As FileDialog

Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim vrtSelectedItem As Variant

Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Dim myfolder As folder
Dim myfile As file
    
TryAgain:
With fd
    .InitialView = msoFileDialogViewDetails ' msoFileDialogViewThumbnail
    .Title = "Folder Selector"
    '.InitialFileName = theFile
    .ButtonName = "Use this folder"
    .AllowMultiSelect = False

    'The user pressed the action button.
    If .Show = True Then
        If .SelectedItems.Count = 0 Then
            MsgBox "You didn't make a valid selection.  Try again!"
            GoTo TryAgain
        End If
        MsgBox .SelectedItems(1)

    '...more code to actually do stuff with the files and subfolder(s) found here
    
       Set myfolder = fs.GetFolder(.SelectedItems(1))
       For Each myfile In myfolder.Files
           If fs.getextensionname(myfile.Name) = "pdf" Then
               MsgBox myfile.Name
               PrintPDF (myfile.Name)
           End If
       Next myfile
    Else
        'bailed
    End If
End With

End Sub

Open in new window

PrintPDFs.mdb
shieldsco

Author

Commented:
I get a runtime error 13 type mismatch......I'm using access 2013...Does that make a difference?

       Set myfolder = fs.GetFolder(.SelectedItems(1))
Nick67
Most Valuable Expert 2014

Commented:
I'll check on a 2013 box tomorrow morning.
It shouldn't make a difference

Error using the sample or error flanging the code into your app?
shieldsco

Author

Commented:
error in my app....also I imported the objects in sample app to my app and I got the same error. I think we are almost there. Thanks
shieldsco

Author

Commented:
Nick - how do I send the files to the printer. I get a popup message for each file however nothing prints...
Nick67
Most Valuable Expert 2014

Commented:
Set myfolder = fs.GetFolder(.SelectedItems(1))
       For Each myfile In myfolder.Files
           If fs.getextensionname(myfile.Name) = "pdf" Then
              MsgBox myfile.Name
               PrintPDF (myfile.Name)
           End If
       Next myfile

In bold is the msgbox
in italics is the line that causes the print.

I don't know why it fails on Access 2013 on Windows 10 x64--and fails silently.
It works for Access 2003 on Windows 7 x64 swimmingly

I really don't know.
@Scott and @Jeff can you test the sample on A2010/A2013 and see if you have the same silent failure?
Jeffrey CoachmanMIS Liason
Most Valuable Expert 2012

Commented:
@Nick,
Yep fails for me on Win 7 64 bit/ Office 2013

FileDialog, user-defined type not defined
error
Nick67
Most Valuable Expert 2014

Commented:
I have the same working on A2013 and A2003 now
Turns out A2003 was willing to print from this
PrintPDF (myfile.Name)
Which isn't the fully qualified path, but just the filename
A2013 needed the full path
PrintPDF (myfile.Path)

Sewed  things up a little tighter, commented out the msgbox on each file and got new API code that will msgbox any error codes.

New sample

What was interesting was the References
It needs one to MS Office xx.0 Object Library and
Windows Script Host Object Model

Usually, touching with a high version breaks references on the lower version.
The app moved back and forth seamlessly

@boag2000, no MS Office xx.0 Object Library breaks the FileDialog unless you late-bind it.
PrintPDFs-v1.mdb
shieldsco

Author

Commented:
Printing works ok now but I still get error 13 type mismatch in line        Set myfolder = fs.GetFolder(.SelectedItems(1)).

I don't see the new sample code...
Most Valuable Expert 2014
Commented:
New sample file
But here is the module code
Option Compare Database
Option Explicit
Public Declare Function apiShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
'***App Window Constants***
Public Const WIN_NORMAL = 1         'Open Normal
Public Const WIN_MAX = 3            'Open Maximized
Public Const WIN_MIN = 2            'Open Minimized

'***Error Codes***
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&

 
Sub PrintPDF(FullPath As String)
Dim printThis
printThis = fPrintFile(FullPath)
MsgBox printThis
End Sub

Function fPrintFile(stFile As String)

    ' This function uses ShellExecute to print, rather than
    ' open, the file.

    Dim lRet As Long, varTaskID As Variant
    Dim stRet As String

    lRet = apiShellExecute(hWndAccessApp, "print", _
            stFile, vbNullString, vbNullString, 0&)
            
    If lRet > ERROR_SUCCESS Then
        stRet = vbNullString
        lRet = -1
    Else
        Select Case lRet
            Case ERROR_NO_ASSOC:
                stRet = "Error: No associated application.  Couldn't print!"
            Case ERROR_OUT_OF_MEM:
                stRet = "Error: Out of Memory/Resources. Couldn't print!"
            Case ERROR_FILE_NOT_FOUND:
                stRet = "Error: File not found.  Couldn't print!"
            Case ERROR_PATH_NOT_FOUND:
                stRet = "Error: Path not found. Couldn't print!"
            Case ERROR_BAD_FORMAT:
                stRet = "Error:  Bad File Format. Couldn't print!"
            Case Else:
        End Select
    End If
    fPrintFile = lRet & _
                IIf(stRet = "", vbNullString, ", " & stRet)
End Function

Open in new window


and the command button code
Private Sub cmdPrintThem_Click()
Dim fd As FileDialog

Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim vrtSelectedItem As Variant

Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Dim myfolder As folder
Dim myfile As file
    
TryAgain:
With fd
    .InitialView = msoFileDialogViewDetails ' msoFileDialogViewThumbnail
    .Title = "Folder Selector"
    '.InitialFileName = theFile
    .ButtonName = "Use this folder"
    .AllowMultiSelect = False

    'The user pressed the action button.
    If .Show = True Then
        If .SelectedItems.Count = 0 Then
            MsgBox "You didn't make a valid selection.  Try again!"
            GoTo TryAgain
        End If
        MsgBox .SelectedItems(1)

    '...more code to actually do stuff with the files and subfolder(s) found here
    
       Set myfolder = fs.GetFolder(.SelectedItems(1))
       For Each myfile In myfolder.Files
           If fs.getextensionname(myfile.Name) = "pdf" Then
               MsgBox myfile.Name
               PrintPDF (myfile.Name)
           End If
       Next myfile
    Else
        'bailed
    End If
End With

End Sub

Open in new window


I don't get errors using the sample in either A2003 or A2013.
The following References are in play, and required.
references
shieldsco

Author

Commented:
I still get an error 13 type mismatch
shieldsco

Author

Commented:
References attached
References.PNG
Nick67
Most Valuable Expert 2014

Commented:
Is this from the sample?
I doubt it, since Outlook isn't referenced.

Does the sample work?
Tell me that FIRST

If it does, move the Outlook 15.0 reference below the Office 15.0  reference in your app, and test.
shieldsco

Author

Commented:
I moved the Outlook 15.0 to below Windows Script Hosts and it seems to work.  I'm on a Citrix server right now at home and not mapped to any printers so I will test tomorrow in the office.
Nick67
Most Valuable Expert 2014

Commented:
Good enough.

Apparently the stranded Reader windows is a 'security features' added by Adobe.
https://forums.adobe.com/thread/1042132

Every one of us would consider it a bug, but apparently Adobe wants you to know when Reader is invoked to print a document.
shieldsco

Author

Commented:
Nick - great job... I awarded Scott 50 points for his contributions

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial