Printing E-mail Attachments When Selecting E-mail


I receive around 20 - 30 e-mails a day, that contain an attachment that I always print out.  Well, doing it as much as I do, it's now a pain - opening e-mail > double clicking file > print, then onto the next e-mail.  Currently, someone has given me a code that I put into Outlook, that when I select e-mails and click a button it will automatically save the attatchments to a specified folder.

Is there some kinda of code inplace, that would act like that in a way?  Meaning, I select all the specific e-mails that I want to deal with, then maybe hit a button then they all start printing out?

Before I had saved all the attachments to the folder, then selected all, then choose print all.  But when I do that, the computer gets crazy and chokes up.  So I'm kinda hoping if what I want is possible & won't choke up my computer.

Who is Participating?
stefriConnect With a Mentor Commented:
Try the following code.
Select the mails with attachments and run the macro printAtt
It will
1 - create a temp folder
2 - save the attachments
3 - print it according the extension (doc, xls, ppt, txt, pdf)
     when printing pdf, you may be have to change the name of executable to be run in line
     cmdline = "Acrobat.exe...."
4 - delete the temporary folder and its content

Private Sub printAtt()
Dim objAttFld As MAPIFolder
Dim objInbox As MAPIFolder
Dim objNS As NameSpace
Dim strProgExt As String
Dim objAtt As Attachment
Dim intPos As Integer
Dim i As Integer
Dim strExt As String
Dim fso As Object
Dim tempFolder As Object, myTempFolder As Object
Dim tempName As String
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection

Dim olDocApp As Object
Dim olDoc As Object
Dim olXlsApp As Object
Dim olXls As Object
Dim olPptApp As Object
Dim olPpt As Object
Dim itm As Object
Dim wshShell As Object
Dim cmdLine As String
Dim strRun As String

Set myOlExp = Application.ActiveExplorer
Set myOlSel = myOlExp.Selection
  On Error Resume Next
  If myOlSel.Count > 0 Then
  Set fso = Application.CreateObject("Scripting.FileSystemObject")
        If Err.Number <> 0 Then
            MsgBox "Need to have WSH installed on your machine. Sorry.", vbOK, "Error"
            Set fso = Nothing
            Exit Sub
        Set tempFolder = fso.GetSpecialFolder(2) 'TempFolder
        tempName = tempFolder & "\" & fso.GetTempName
        Set myTempFolder = fso.CreateFolder(tempName)
        For Each itm In myOlSel
          ' itm.PrintOut '------------------ Uncomment if you want to print the selected mail also
          For Each objAtt In itm.Attachments
            intPos = InStrRev(objAtt.FileName, ".")
            strExt = LCase(Mid(objAtt.FileName, intPos + 1))
            Select Case strExt
                Case "doc"
                    objAtt.SaveAsFile myTempFolder & "\" & objAtt.DisplayName
                    Set olDocApp = Application.CreateObject("Word.Application")
                    Set olDoc = olDocApp.Documents.Open(myTempFolder & "\" & objAtt.DisplayName)
                    olDoc.Close 0
                    Set olDocApp = Nothing
                Case "xls"
                    objAtt.SaveAsFile myTempFolder & "\" & objAtt.DisplayName
                    Set olXlsApp = Application.CreateObject("Excel.Application")
                    Set olXls = olXlsApp.Workbooks.Open(myTempFolder & "\" & objAtt.DisplayName)
                    olXls.Close 0
                    Set olXls = Nothing
                    Set olXlsApp = Nothing
                Case "ppt"
                    objAtt.SaveAsFile myTempFolder & "\" & objAtt.DisplayName
                    Set olPptApp = Application.CreateObject("Powerpoint.Application")
                    Set olPpt = olPptApp.Presentations.Open(myTempFolder & "\" & objAtt.DisplayName)
                    olPpt.Close 0
                    Set olPpt = Nothing
                    Set olPptApp = Nothing

                Case "pdf"
                    objAtt.SaveAsFile myTempFolder & "\" & objAtt.DisplayName
                    Set wshShell = Application.CreateObject("Wscript.Shell")
                    cmdLine = "Acrobat.exe /p /h " & myTempFolder & "\" & objAtt.DisplayName
                    strRun = wshShell.Run(cmdLine, 1, True)
                    Set wshShell = Nothing
               Case "txt"
                    objAtt.SaveAsFile myTempFolder & "\" & objAtt.DisplayName
                    Set wshShell = Application.CreateObject("Wscript.Shell")
                    cmdLine = "notepad.exe /p " & myTempFolder & "\" & objAtt.DisplayName
                    strRun = wshShell.Run(cmdLine, 1, True)
                    Set wshShell = Nothing
                Case Else
                End Select
                Set objAtt = Nothing
        Set itm = Nothing
        Set tempFolder = Nothing
      fso.DeleteFolder myTempFolder
      Set fso = Nothing
    End If
End If

End Sub
Hope you'll like it
xp310Author Commented:

I've just tested out the code which did work.  But I did have two problems.  My first problem is that I can't run it from the macro list.  The name of this code 'printAtt' isn't listed.  I can only run this from the VBA project area.

Also, when I do run it, I get a message saying that if I close out Word, all pending print jobs will be cancelled.  I selected no that I didn't want it to close.  But in doing that, I have to click no for every attachment it's printing.  Is there a way to avoid this?

a) subsititue Private to Public
    Private Sub printAtt() -> Public Sub printAtt()
b)                    olDoc.PrintOut
                    Do Until olDocApp.Application.BackgroundPrintingStatus = 0
                    olDoc.Close 0
                    Set olDocApp = Nothing

should do the trick (did it with office 10: word 2002, ol2002)
Introducing Cloud Class® training courses

Tech changes fast. You can learn faster. That’s why we’re bringing professional training courses to Experts Exchange. With a subscription, you can access all the Cloud Class® courses to expand your education, prep for certifications, and get top-notch instructions.

xp310Author Commented:

It took me a bit to figure out exactly where I was placing Step B.  But I figured it out.  It works great.  Thank you so much.  I appreciate it.

xp310Author Commented:
After further testing this out...

Step B actually freezes up Outlook.  If I leave out step B, and continue to hit the "No" in closing out of Word, then I'm fine.  I guess I can live with those popups.  It's still easier, then dealing with opening all these up seperatly.

Do Until olDocApp.Application.BackgroundPrintingStatus = 0
should be Do Until olDocApp.BackgroundPrintingStatus = 0
I do not understand why OL freezes: I tested it with Office 10 without problem on a mail having 5 word attachments


Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.