Outlook 2013 Print Automatically Attachments

Itmonitor

New Member
Outlook version
Outlook 2013 64 bit
Email Account
IMAP
Hi!

I use Outlook 2013 64 bit standalone with Windows 10 Anniversary Edition.

Up to now, when I receive pdf invoices in a certain email account, I need to open the email and print them manually. There is the usual Rules settings into Outlook 2013 that will print all the pdf files attached to received emails. But this is not a solution in my case.

I have an email account that is exclusively used to receive invoices from purchases. The invoices are in pdf format. However, upon purchase some suppliers also send automatically pdf files with standard information about product returns, and other legalities concerning the purchase I just did. Some have 10 pages or so. For this reason, if I set to print automatically all pdf attachments from emails received in this specific email account, it will result in a huge waste of paper, ink, not to say the time to sort out manually the invoices from the other printed pdf email attachments. Therefore, it defeats the purpose of streamlining the invoice printing process.

I thought about selecting the emails through their Subjects. In my case, we receive from suppliers in three countries in Europe. So the email Subjects can come as Invoice or Facture or Rechnung according to the language. I do not know if there is a way to do this email selection by email Subject.

Other idea is to limit the printing only to one page. Invoices in my case are always one page pdf. In this way, when I receive the other pdf documents (not invoices), even if they have manhy pages, Outlook would print only the first page. This will limit manual work to select the printed invoices from the other useless documents.

Well, this is the problem I am facing. Any advice is welcome! :)
 

Michael Bauer

Senior Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
Here's a sample for printing automatically:
Print Attachments Automatically - VBOffice

In the ItemAdd event replace the PrintAttachments line by:
if instr(Item.Subject,"Rechnung")>0 or instr(Item.Subject,"Invoice")>0 then
PrintAttachments Item
endif
(Extend the If statement to suit your needs.) Also, add ".pdf" to the case statement at the bottom.
 

Itmonitor

New Member
Outlook version
Outlook 2013 64 bit
Email Account
IMAP
Hi Michael, thank you for pointing out the VBA routine.

I did the modifications, but I am a newbie and still stuck with the points below:

1. The macro is marked in red at its first line, from Private Declare Functions until PrivatewithEvents line. This means I did something wrong or there is a bug in the macro.
2. I would need this macro to work only with one email account, not all email accounts in my Outlook 2013

I paste here the whole macro after my modifications. The macro instructions in italic are in red for me here on my side.

Any advice is welcome! :)

I.M.

Sub PrintAttachmentsPDF()
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

Private WithEvents Items As Outlook.Items


Private Sub Application_Startup()
Dim Ns As Outlook.NameSpace
Dim Folder As Outlook.MAPIFolder

Set Ns = Application.GetNamespace("MAPI")
Set Folder = Ns.GetDefaultFolder(olFolderInbox)
Set Items = Folder.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
If InStr(Item.Subject, "Rechnung") > 0 Or InStr(Item.Subject, "Invoice") > 0 Or InStr(Item.Subject, "Facture") > 0 Then
PrintAttachments Item
End If
End If
End Sub

Private Sub PrintAttachments(oMail As Outlook.MailItem)
On Error Resume Next
Dim colAtts As Outlook.Attachments
Dim oAtt As Outlook.Attachment
Dim sFile As String
Dim sDirectory As String
Dim sFileType As String

sDirectory = "C:\Users\xxxx\Desktop\xxx\Printed Email Invoices"

Set colAtts = oMail.Attachments

If colAtts.Count Then
For Each oAtt In colAtts

sFileType = LCase$(Right$(oAtt.FileName, 4))

Select Case sFileType
Case ".pdf"
sFile = ATTACHMENT_DIRECTORY & oAtt.FileName
oAtt.SaveAsFile sFile
ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
End Select
Next
End If
End Sub
End Sub
 

Michael Bauer

Senior Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
simply copy&paste the code as it is, and do only the mentioned modifications.
 

Similar threads

Top