15 49.0138 8.38624 1 1 5000 1 http://www.justinhall.us 300 0

Set Outlook to Print Attachments automatically

Been hunting for a macro or tool or rule to have Outlook print your email attachment? Look no further. I have combined some publically available VBA code into a working solution. With the below -and a simple Outlook rule- you can force Outlook to print your attachment when certain rule conditions are met.

Here is how it works. The below code, to be pasted in full into the ThisOutlookSession module, causes Outlook to save off the attachment and print it when an email (with attachment) is dropped into the ‘Print Automatically’ folder. Use an Outlook rule to copy/move an inbound email to the ‘Print Automatically’ folder.

Instructions:

  • Copy the below into the ThisOutlookSession module. Use Alt-F11 to open the VBA editor inside of Outlook.
  • Create a folder called Print Automatically underneath your default mail Inbox.
  • Make sure that c:\temp is writeable or change the location in the script.
  • Create a rule (optional) to move/copy mail to the Print Automatically folder. Example: inbound email with a ‘autoprint’ subject gets moved to that folder.
  • Restart Outlook.

Done!


'###############################################################################
'### Module level Declarations
'Set the Temp file folder where you want attachments saved-off

Option Explicit
Dim WithEvents TargetFolderItems As Items
'set the string constant for the path to save attachments
Const FILE_PATH As String = "C:\Temp\"

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

'###############################################################################
'### this is the Application_Startup event code in the ThisOutlookSession module
' All code should be pasted into ThisOutlookSession module
Private Sub Application_Startup()
'some startup code to set our "event-sensitive" items collection

Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim msg As Outlook.MailItem

Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
Set olFolder = olFolder.Folders("Print Automatically")

Set TargetFolderItems = olFolder.Items

End Sub

'###############################################################################
'### this is the ItemAdd event code
'when a new item is added to our "watched folder" we can process it

Sub TargetFolderItems_ItemAdd(ByVal Item As Object)

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

Set colAtts = Item.Attachments

If colAtts.Count Then
For Each oAtt In colAtts

' Find the filename extension - can be 3 or 4 chars
Dim pos As Long
pos = Len((oAtt.FileName)) - InStr(1, oAtt.FileName, ".", vbTextCompare) + 1

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

Select Case sFileType

' Add additional file types below
Case ".xlsx", ".docx", ".pdf", ".doc", ".xls", ".ppt", ".pptx"

' Save the file to the temp file location
sFile = FILE_PATH & oAtt.FileName
oAtt.SaveAsFile sFile
ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
End Select
Next
End If

End Sub

'###############################################################################
'### this is the Application_Quit event code in the ThisOutlookSession module
Private Sub Application_Quit()

Dim ns As Outlook.NameSpace
Set TargetFolderItems = Nothing
Set ns = Nothing

End Sub

Previous Post
Trebuchet Report
Next Post
giffgaff on the O2 network