Saving/Deleting All Attachments With One Click

from http://techniclee.wordpress.com

Saving/Deleting All Attachments With One Click:

This post is in response to a tweet from petemarcus that was retweeted by malcolmcoles. Here’s what petemarcus said:

Dull tweet alert. Microsoft Outlook needs a ‘remove all attachments’ button as well as ‘save all’. Good to get that off my chest.

While Pete and Malcolm wait for Microsoft to add these capabilities to Outlook they can use the code below to accomplish both tasks. The code is very simple. Implement a loop that processes all selected items. For each item process all attachments. If the attachment isn’t a hidden item, then either delete it or save it. Hidden attachments are embedded in the item (e.g. a graphic in the signature) and should not be processed. In the save attachments routine I’m using Microsoft Excel’s folder picker dialog-box since Outlook doesn’t have one of its own. This solution should work in Outlook 2003 and later.

Code.

Here then is the code for either saving or deleting all attachments. Follow these instructions to add it to Outlook.

1. Start Outlook


2. Click Tools > Macro > Visual Basic Editor


3. If not already expanded, expand Microsoft Office Outlook Objects


4. If not already expanded, expand Modules


5. 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


6. Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook’s VB Editor window


7. Edit the code as needed. I included comments wherever something needs to or can change


8. Click the diskette icon on the toolbar to save the changes


9. Close the VB Editor

Sub DeleteAllAttachments()
   Dim olkMsg As Object, intIdx As Integer
   For Each olkMsg In Application.ActiveExplorer.Selection
       For intIdx = olkMsg.Attachments.Count To 1 Step -1
           If Not IsHiddenAttachment(olkMsg.Attachments.Item(intIdx)) Then
               olkMsg.Attachments.Item(intIdx).Delete
           End If
       Next
       olkMsg.Save
   Next
   Set olkMsg = Nothing
End Sub

Sub SaveAllAttachments()
   Const msoFileDialogFolderPicker = 4
   Dim olkMsg As Object, intIdx As Integer, excApp As Object, strPath As String
   Set excApp = CreateObject("Excel.Application")
   With excApp.FileDialog(msoFileDialogFolderPicker)
       .Show
       For intIdx = 1 To .SelectedItems.Count
           strPath = .SelectedItems(intIdx)
       Next
   End With
   If strPath <> "" Then
       For Each olkMsg In Application.ActiveExplorer.Selection
           For intIdx = olkMsg.Attachments.Count To 1 Step -1
               If Not IsHiddenAttachment(olkMsg.Attachments.Item(intIdx)) Then
                   olkMsg.Attachments.Item(intIdx).SaveAsFile strPath & "\" & olkMsg.Attachments.Item(intIdx).FileName
               End If
           Next
           olkMsg.Save
       Next
   End If
   Set excApp = Nothing
   Set olkMsg = Nothing
End Sub

Private Function IsHiddenAttachment(olkAttachment As Outlook.Attachment) As Boolean
   'Purpose: Determines if an attachment is embedded.'
   'Written: 10/12/2010'
   'Outlook: 2007'
   Dim olkPA As Outlook.PropertyAccessor
   On Error Resume Next
   Set olkPA = olkAttachment.PropertyAccessor
   IsHiddenAttachment = olkPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x7ffe000b")
   On Error GoTo 0
   Set olkPA = Nothing
End Function

Usage.

• Select one or more items


• Run the macro DeleteAllAttachments to delete attachments or SaveAllAttachments to save them.

One Click

Running the macros with a single click requires a bit more work. In Outlook 2003 and 2007 we’ll add a button to the toolbar. Outlook 2010 uses the ribbon, so for this version we’ll add a button to the Quick Access Toolbar (QAT).

Outlook 2003/2007. Follow these instructions to add toolbar buttons that run these macros.

Outlook 2010. Follow these instructions to add both macros to the QAT.

Filed under: Outlook Tagged: Outlook, Twitter, VBA