Question : Print pdf, word, and excel email attachments from inbox folder

Hi,

I would like to print multiple email attachments automatically. The attached files is excel files, pdf, and/or word documents. I only want to print the attachments without the email message. The email messages are already located in my inbox folder. Is there a macro to do this?.

My version of outlook is outlook 2007, excel 2003, and word 2003
The macro below below works for printing excel attachments and I want to add to it pdf and word.

Thank You,
Amreska

         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:

           
           
          Private 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

Sub printExcelAttachments()
Dim itms As Object
Dim itm As Object
Dim sh As Object
Dim att As Object
Dim objFSO As Object
Dim objTempFolder As Object
Dim dlg As FileDialog
Dim xlApp As Object
Dim xlWB As Object
Dim xlWS As Object
 
    Set itms = Application.ActiveExplorer.Selection
 
    'On Error Resume Next
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objTempFolder = objFSO.GetSpecialFolder(2)
    Set xlApp = CreateObject("excel.application")
    For Each itm In itms
        For Each att In itm.Attachments
            Select Case LCase(Right(att.FileName, Len(att.FileName) - InStrRev(att.FileName, ".")))
            Case "xls"
                att.SaveAsFile objTempFolder & "\" & att.FileName
                xlApp.workbooks.Open objTempFolder & "\" & att.FileName
                For Each xlWS In xlApp.workbooks(1).worksheets
                    xlWS.PrintOut
                Next
                xlApp.workbooks(1).Close False
            Case "xlsm"
                att.SaveAsFile objTempFolder & "\" & att.FileName
                xlApp.workbooks.Open objTempFolder & "\" & att.FileName
                For Each xlWS In xlApp.workbooks(1).worksheets
                    xlWS.PrintOut
                Next
                xlApp.workbooks(1).Close False
'            Case "123"
'                att.SaveAsFile objTempFolder & "\" & att.Filename
'                xlApp.workbooks.Open objTempFolder & "\" & att.Filename
'                For Each xlWS In xlApp.workbooks(1).worksheets
'                    xlWS.PrintOut
'                Next
'                xlApp.workbooks(1).Close False
'            Case "456"
'                att.SaveAsFile objTempFolder & "\" & att.Filename
'                xlApp.workbooks.Open objTempFolder & "\" & att.Filename
'                For Each xlWS In xlApp.workbooks(1).worksheets
'                    xlWS.PrintOut
'                Next
'                xlApp.workbooks(1).Close False
            End Select
        Next
    Next
    xlApp.Quit
End Sub

           
         

Answer : Print pdf, word, and excel email attachments from inbox folder

Alternatively keep the API call at the top as before and use:

Chris

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:

           
           
             Sub printExcelAttachments()
Dim itms As Object
Dim itm As Object
Dim sh As Object
Dim att As Object
Dim objFSO As Object
Dim objTempFolder As Object
Dim dlg As FileDialog
Dim xlApp As Object
Dim xlWB As Object
Dim xlWS As Object
 
    Set itms = Application.ActiveExplorer.Selection
 
    'On Error Resume Next
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objTempFolder = objFSO.GetSpecialFolder(2)
    Set xlApp = CreateObject("excel.application")
    For Each itm In itms
        For Each att In itm.Attachments
            Select Case LCase(Right(att.Filename, Len(att.Filename) - InStrRev(att.Filename, ".")))
            Case "xls"
                att.SaveAsFile objTempFolder & "\" & att.Filename
                xlApp.workbooks.Open objTempFolder & "\" & att.Filename
                For Each xlWS In xlApp.workbooks(1).worksheets
                    xlWS.PrintOut
                Next
                xlApp.workbooks(1).Close False
            Case "xlsm"
                att.SaveAsFile objTempFolder & "\" & att.Filename
                xlApp.workbooks.Open objTempFolder & "\" & att.Filename
                For Each xlWS In xlApp.workbooks(1).worksheets
                    xlWS.PrintOut
                Next
                xlApp.workbooks(1).Close False
            Case "doc"
                att.SaveAsFile objTempFolder & "\" & att.Filename
                ShellExecute 0&, "Print", objTempFolder & "\" & att.Filename, 0&, 0&, 0&
            Case "pdf"
                att.SaveAsFile objTempFolder & "\" & att.Filename
                ShellExecute 0&, "Print", objTempFolder & "\" & att.Filename, 0&, 0&, 0&
            End Select
        Next
    Next
    xlApp.Quit
End Sub
           
         