How to automatically print attachments in an email?

Question

Every day I receive hundreds of emails with pdf attachments of invoices that I need to print off.

Currently, I print them off manually and it takes me upwards of a couple hours a day.

How do I auto print attachment in the emails using Outlook-vba and then delete that email.

Have a look at this answer: https://stackoverflow.com/a/12146315/973283. The question is not relevant to your requirement. The macro within the answer outputs selected properties of every email in Inbox to an Excel workbook to help the OP understand the nature of those properties. It shows how to read down Inbox and how to access the names of any attachments. This would provide the basis of the macro you require. You will have to check the extension of an attachment is PDF. A macro cannot process an attachment. You will have to save the PDF attachments and then print them. — Tony Dallimore, Jun 07 '19 at 16:44
Having said all that, printing hundreds of emails per day is a waste of paper. As they say: "Save a tree for you and me". — Tony Dallimore, Jun 07 '19 at 16:46
Some of the related questions (see down right side below linked) look interesting. — Tony Dallimore, Jun 07 '19 at 16:48
I wish that were the case but upper management likes everything on paper. Thank yiy — Djhans26, Jun 07 '19 at 16:48

score 1 · Answer 1 · answered Jun 11 '19 at 06:30

Add Microsoft Scripting Runtime to References...

Create New Rule, then click on Apply rule on messages I receive / which has an attachment / run a script

Option Explicit
Public Sub Example(Item As Outlook.MailItem)
    Dim FSO As FileSystemObject
    Set FSO = New FileSystemObject

    'Temporary Folder
    Dim TempFldr As String
        TempFldr = Environ("USERPROFILE") & "\Documents\Temp\"
        CreateDir TempFldr

    Dim Atmt As Attachment
    Dim AtmtName As String
    Dim oShell As Object
    Dim Fldr As Object
    Dim FldrItem As Object

    For Each Atmt In Item.Attachments
        AtmtName = TempFldr & Atmt.FileName
        Atmt.SaveAsFile AtmtName

        Set oShell = CreateObject("Shell.Application")
        Set Fldr = oShell.NameSpace(0)
        Set FldrItem = Fldr.ParseName(AtmtName)
            FldrItem.InvokeVerbEx ("print")
    Next Atmt

    'Cleans up
    If Not FSO Is Nothing Then Set FSO = Nothing
    If Not Fldr Is Nothing Then Set Fldr = Nothing
    If Not FldrItem Is Nothing Then Set FldrItem = Nothing
    If Not oShell Is Nothing Then Set oShell = Nothing

End Sub

Private Function CreateDir(FldrPath As String)
    Dim Elm As Variant
    Dim CheckPath As String

    CheckPath = ""
    For Each Elm In Split(FldrPath, "\")
        CheckPath = CheckPath & Elm & "\"

        If Len(Dir(CheckPath, vbDirectory)) = 0 Then
            MkDir CheckPath
            Debug.Print CheckPath & " Folder Created"
        End If

        Debug.Print CheckPath & " Folder Exist"
    Next
End Function

How to automatically print attachments in an email?

1 Answers1