How to automatically print attachments in an email? - vba

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.

Answer 1

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