Automatically Printing/Saving Emails/Attachments in Outlook

Issue.  One of the more frequent Outlook questions I see here on EE is "How can I automatically save or print an email and/or its attachments?"  There are a number of variations to the basic question.  For example, "How can I save attachments to a specific file system folder?" or "How can I print a message and all its attachments to a specific printer?" or "How can I print a specific type of attachment?" or "My organization places a strict limit on mailbox size.  How can I save attachments to the file system and insert a link to them in the original message thereby saving space in my mailbox?".

Background.  Outlook’s rules wizard does include the "print it" action which will print the message, but will not print the attachments.  If you manually print an item, then you can elect to print the attachments too, but only to the default printer.  The rules wizard does not include an action for saving a message or attachment to the file system, nor saving and replacing attachments with hyperlinks to them.  

Solution.  The solution is to use a bit of scripting, a macro, and a rule to perform the desired actions.  The rule is triggered when an item meeting a given condition arrives.  The rule calls the macro which performs the actual work.  

Until now I’ve handled each question requesting one of these capabilities individually.  That is, I wrote a custom macro to address each author’s specific needs.  If the author wanted to print a given attachment, then I produced a macro that would do just that.  If instead they wanted to save and remove attachments replacing them with hyperlinks in the message itself, then I wrote a macro for that alone.  

Recently I saw another of these questions and decided it was time to put together a macro that would handle almost any of these situations.  This macro has the ability to perform any combination of the following actions:

  a.  Print the message.
  b.  Print the message to a specific printer.
  c.  Save the message to a specific folder in the file system.
  d.  Save the message in a specific format.
  e.  Print all attachments.
  f.  Print only certain types of attachments (e.g. all .doc, .wks, .pdf).
  g.  Print attachments to a specific printer.
  h.  Save attachments to a specific folder in the file system.
  i.  Remove (save and delete) attachments replacing each with a hyperlink to the saved attachment.
      The hyperlinks are inserted at the bottom of the message.

Requirements.  Microsoft Outlook.  The macro should work with any version of Outlook from 2000 on, but I’ve only tested it with 2007.  The instructions assume that you are using Outlook 2007.

Instructions.  Follow these instructions to use this solution.

Add the Macro to Outlook

  a.  Start Outlook.
  b.  Click Tools > Macro  > Visual Basic Editor.
  c.  If not already expanded, expand Microsoft Office Outlook Objects.
  d.  If not already expanded, expand Modules.
  e.  Select an existing module (e.g. Module1) by double-clicking on it or create a new module 
       by right-clicking Modules and selecting Insert  > Module.
  f.  Copy the code below and paste it into the right-hand pane of Outlook's VB Editor window.
  g.  Edit the code as needed.  I included comments wherever something needs to or can change.
  h.  Click the diskette icon on the toolbar to save the changes.

Public Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" _
        (ByVal lpAppName As String, ByVal lpKeyName As String, _
        ByVal lpDefault As String, ByVal lpReturnedString As String, _
        ByVal nSize As Long) As Long

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

Sub MessageAndAttachmentProcessor(Item As Outlook.MailItem, _
    Optional bolPrintMsg As Boolean, _
    Optional bolSaveMsg As Boolean, _
    Optional bolPrintAtt As Boolean, _
    Optional bolSaveAtt As Boolean, _
    Optional bolInsertLink As Boolean, _
    Optional strAttFileTypes As String, _
    Optional strFolderPath As String, _
    Optional varMsgFormat As OlSaveAsType, _
    Optional strPrinter As String)
   
    Dim olkAttachment As Outlook.Attachment, _
        objFSO As FileSystemObject, _
        strMyPath As String, _
        strExtension As String, _
        strFileName As String, _
        strOriginalPrinter As String, _
        strLinkText As String, _
        strRootFolder As String, _
        strTempFolder As String, _
        varFileType As Variant, _
        intCount As Integer, _
        intIndex As Integer, _
        arrFileTypes As Variant

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    strTempFolder = Environ("TEMP") & "\"
    
    If strAttFileTypes = "" Then
        arrFileTypes = Array("*")
    Else
        arrFileTypes = Split(strAttFileTypes, ",")
    End If
    
    If bolPrintMsg Or bolPrintAtt Then
        If strPrinter <> "" Then
            strOriginalPrinter = GetDefaultPrinter()
            SetDefaultPrinter strPrinter
        End If
    End If
    
    If bolSaveMsg Or bolSaveAtt Then
        If strFolderPath = "" Then
            strRootFolder = Environ("USERPROFILE") & "\My Documents\"
        Else
            strRootFolder = strFolderPath & IIf(Right(strFolderPath, 1) = "\", "", "\")
        End If
    End If
    
    If bolSaveMsg Then
        Select Case varMsgFormat
            Case olHTML
                strExtension = ".html"
            Case olMSG
                strExtension = ".msg"
            Case olRTF
                strExtension = ".rtf"
            Case olDoc
                strExtension = ".doc"
            Case olTXT
                strExtension = ".txt"
            Case Else
                strExtension = ".msg"
        End Select
        Item.SaveAs strRootFolder & RemoveIllegalCharacters(Item.Subject) & strExtension, varMsgFormat
    End If
        
    For intIndex = Item.Attachments.count To 1 Step -1
        Set olkAttachment = Item.Attachments.Item(intIndex)
        'Print the attachments if requested'
        If bolPrintAtt Then
            If olkAttachment.Type <> olEmbeddeditem Then
                For Each strFileType In arrFileTypes
                    If (strFileType = "*") Or (LCase(objFSO.GetExtensionName(olkAttachment.FileName)) = LCase(strFileType)) Then
                        olkAttachment.SaveAsFile strTempFolder & olkAttachment.FileName
                        ShellExecute 0&, "print", strTempFolder & olkAttachment.FileName, 0&, 0&, 0&
                    End If
                Next
            End If
        End If
        'Save the attachments if requested'
        If bolSaveAtt Then
            strFileName = olkAttachment.FileName
            intCount = 0
            Do While True
                strMyPath = strRootFolder & strFileName
                If objFSO.FileExists(strMyPath) Then
                    intCount = intCount + 1
                    strFileName = "Copy (" & intCount & ") of " & olkAttachment.FileName
                Else
                    Exit Do
                End If
            Loop
            olkAttachment.SaveAsFile strMyPath
            If bolInsertLink Then
                If Item.BodyFormat = olFormatHTML Then
                    strLinkText = strLinkText & "<a href=""file://" & strMyPath & """>" & olkAttachment.FileName & "</a><br>"
                Else
                    strLinkText = strLinkText & strMyPath & vbCrLf
                End If
                olkAttachment.Delete
            End If
        End If
    Next
    
    If bolPrintMsg Then
        Item.PrintOut
    End If
    
    If bolPrintMsg Or bolPrintAtt Then
        If strOriginalPrinter <> "" Then
            SetDefaultPrinter strOriginalPrinter
        End If
    End If
    
    If bolInsertLink Then
        If Item.BodyFormat = olFormatHTML Then
            Item.HTMLBody = Item.HTMLBody & "<br><br>Removed Attachments<br><br>" & strLinkText
        Else
            Item.Body = Item.Body & vbCrLf & vbCrLf & "Removed Attachments" & vbCrLf & vbCrLf & strLinkText
        End If
        Item.Save
    End If

    Set objFSO = Nothing
    Set olkAttachment = Nothing
End Sub

Function GetDefaultPrinter() As String
    Dim strPrinter As String, _
        intReturn As Integer
    strPrinter = Space(255)
    intReturn = GetProfileString("Windows", ByVal "device", "", strPrinter, Len(strPrinter))
    If intReturn Then
        strPrinter = UCase(Left(strPrinter, InStr(strPrinter, ",") - 1))
    End If
    GetDefaultPrinter = strPrinter
End Function

Function RemoveIllegalCharacters(strValue As String) As String
    ' Purpose: Remove characters that cannot be in a filename from a string.'
    ' Written: 4/24/2009'
    ' Author:  BlueDevilFan'
    ' Outlook: All versions'
    RemoveIllegalCharacters = strValue
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "<", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, ">", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, ":", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, Chr(34), "'")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "/", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "\", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "|", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "?", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "*", "")
End Function

Sub SetDefaultPrinter(strPrinterName As String)
    Dim objNet As Object
    Set objNet = CreateObject("Wscript.Network")
    objNet.SetDefaultPrinter strPrinterName
    Set objNet = Nothing
End Sub

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:

Select allOpen in new window

2

Create a Subroutine That Calls the Macro

We can’t call the macro directly from a rule since the macro requires parameters to tell it what actions to take and we can’t pass those parameters from a rule.  Instead you need to create a subroutine of your own that calls the macro and tells it which actions you want it to perform for the given message.  You can create as many subroutines as you need.  Typically you’ll have one subroutine for each set of actions you want to perform.  

For example, assume that you receive messages pertaining to a project you’re working on, we’ll call it Project X, and you receive a daily message from accounting that includes a rather large spreadsheet attachment.  You want to automatically print and save theProject X messages, while for the accounting messages you want to remove the attached spreadsheet and replace it with a hyperlink.  Since the actions are required are different you’d need to create a subroutine for each.  You can create your subroutine(s) in the same module with the other macro code or you can place it in another module.  The decision is yours.  

To create a subroutine:

  a.  Start Outlook.
  b.  Click Tools > Macro  > Visual Basic Editor.
  c.  If not already expanded, expand Microsoft Office Outlook Objects.
  d.  If not already expanded, expand Modules.
  e.  Select an existing module (e.g. Module1) by double-clicking on it or create a new module by 
       right-clicking Modules and selecting Insert > Module.
  f.  Copy the code below and paste it into the right-hand pane of Outlook's VB Editor window.
  g.  Edit the code.  At a minimum you must give the subroutine a unique name and you must 
       set the parameters.  
  h.  Click the diskette icon on the toolbar to save the changes.

Parameters.
The macro takes a maximum of nine parameters.  In the code below these are represented as P1 through P9.  The parameters are positional (i.e. they must appear in the sequence given).

P1.  Print the message.
Tells the macro to print the email.  Valid values are True or False.

P2.  Save the message.
Tells the macro to save the email to the file system.  Valid values are True or False.

P3.  Print the attachments.
Tells the macro to print the attachments.  Valid values are True or False.

P4.  Save the attachments.
Tells the macro to save the attachments.  Valid values are True or False.

P5.  Remove attachments.
Tells the macro to remove the attachments and insert hyperlinks to  them at the bottom of the message.  Valid values are True or False.

P6. Attachment types.
Tells the macro what attachment types to save/print.  The macro will only process attachments that match the file types.  This parameter is a comma separated list of file extensions.  For example, to only process Word documents (both 2007 and earlier) you’d set this parameter to "doc,docx".

P7. Target file system folder.
This tells the macro which file system folder to save the message and/or attachments to.  Valid values are any existing file system folder, including network shares and UNC paths.  If you’ve told the macro to save the message and/or attachments and you fail to specify this parameter, then the macro will save the items to your My Documents folder.

P8. Message save format.
Tells the macro what format to save the message in (assuming that you are saving the message).  You will be prompted with a list of valid values when you enter this parameter.

P9. Printer name.
Tells the macro what printer to print the message and/or attachments to.  This allows you to print to any printer, not just the default printer.  Valid values include the name of any printer that appears in your list of printers.  If you’ve told the macro to print the message and/or attachments and you don’t specify a printer, then the macro will print them to your default printer.

All the parameters are optional so you can omit those that you don’t need.

‘Change MySubroutineName to a unique name on the next line’
Sub MySubroutineName(Item As Outlook MailItem)
        MessageAndAttachmentProcessor Item, P1, P2, P3, P4, P5, P6, P7, P8, P9
End Sub

1:
2:
3:
4:

Select allOpen in new window

Examples Of Usage

• You want to print all messages to the default printer.
  MessageAndAttachmentProcessor Item, True

• You want to print all messages to a non-default printer named "HP Deskjet 3320".
  MessageAndAttachmentProcessor Item, True, , , ,,,,,"HP Deskjet 3320"

• You want to save all attachments to a folder on your C: drive named "Project X".
  MessageAndAttachmentProcessor Item,,,,True,,"C:\Project X"

• You want to remove all PDF attachments to a folder on your C: drive named "Accounting" and insert a hyperlink to the saved attachment.
  MessageAndAttachmentProcessor Item,,,,True,True,"pdf","C:\Accounting"

• You want to print all Word documents to the default printer.
  MessageAndAttachmentProcessor Item,,,True,,"doc,docx"

3

Configure Security

  a.  Click Tools > Trust Center.
  b.  Click Macro Security.
  c.  Set Macro Security to Warnings for all macros.
  d.  Click OK.
  e.  Close Outlook.
  f.  Start Outlook.

4

Create a Rule that Triggers the Subroutine

  a.  Click Tools > Rules and Alerts.
  b.  Click the New Rule button.
  c.  Under "Start from a blank rule" select Check messages when they arrive.
  d.  Click the Next button.
  e.  Select a condition for the messages you want to process.  If you want the macro to run against 
       all messages, then don’t select a condition.  Outlook will display a dialog-box warning  you 
       that "This rule will be applied to every message you receive.  Is this correct?".   ClickYes.
  f.  Click the Next button.
  g.  Place a check in the box next to run a script.
  h.  In the lower pane click the underlined a script.  Select your subroutine as the script to run.
  i.   Work your way through the rest of the Rules Wizard.