How to remove attachments from outlook (2007) emails easily

NicolD — Sun, 26 Nov 2006 13:38:00 GMT

I receive often emails with big attachment that fill my inbox space very quickly.

On the other side, I usually like both to remove these attach and keep the email to preserve the thread for future use. Outlook 2007 don't have this feature so I wrote the following VBA function I added to a button on my client that resolve easily this task.

TIP: You can select more message at once too. This is useful if you want to clear a big number of messages you already have archivied.

Hope this helps!

Nicola

Note: I already developed this VBA for outlook 2003, but Outlook 2007 requires some small update. following code should work.

UPDATE (09/06/09): Thanks to John Harvey and Patrick Philippot now the procedure save attachments in a specific folder and make good use of outlook memory:-)

' by Nicola Delfino
'       30-03-2005: First version
'       26-11-2006: Updated for Outlook 2007
'       28-11-2006: Updated with notes from rgreg
' Modified by John Harvey and Patrick Philippot
'       09-06-2009: Saves the file(s) to a folder location
'                   Memory problem with many attach to remove (FIXED)
'
'
'   based on code found at on http://www.outlookcode.com/
'
' Setup and instructions
' (1) Digitally sign VBA project
'          start->office->Microsoft office tools->digital certificates for VBA
'          create a certificate
' (2) sign the code
'          from Outlook -> menu -> Tools -> Macros -> Visual Basic Editor (VBA)
'          project 1 -> Microsoft Office Outlook -> ThisOutlookSession (double ckick)
'          * paste this source code *
'          from Microsoft Visual Basic -> menu -> Tools -> digital signature -> (choose certificate previously created)
' (3) add icon on toolbar
'          from outlook
'          tools->customize (select "Commands" TAB)
'                add icon on toolbar
'                [rearrange commands] to change icon and name on toolbar
' (4) be sure that tools->macros->security
'               on "thrusted publishers" "trust all installed add-ins and templates" is checked
'
'
 
 
 
Public Sub StripAttachments()
    Dim ilocation As String
    Dim objOL As Outlook.Application
    Dim objMsg As Object
    Dim objAttachments As Outlook.Attachments
    Dim objSelection As Outlook.Selection
    Dim i As Long
    Dim lngCount As Long
    Dim strFile As String
    Dim strFolder As String
 
    Dim result
    
    'Put in the folder location you want to save attachments to
    ilocation = "D:\nicold-MyDocuments\Removed Attachs\"
    
    On Error Resume Next
    
    result = MsgBox("Do you want to remove attachments from selected email(s)?", vbYesNo + vbQuestion)
    If result = vbNo Then
        Exit Sub
    End If
    
    ' Instantiate an Outlook Application object.
    ' Set objOL = CreateObject("Outlook.Application")
    Set objOL = Application
    ' Get the collection of selected objects.
    Set objSelection = objOL.ActiveExplorer.Selection
 
    ' Check each selected item for attachments.
    ' If attachments exist, save them to the Temp
    ' folder and strip them from the item.
    For Each objMsg In objSelection
        ' This code only strips attachments from mail items.
        If objMsg.Class = olMail Then
            ' Get the Attachments collection of the item.
            Set objAttachments = objMsg.Attachments
            lngCount = objAttachments.Count
            If lngCount > 0 Then
                ' We need to use a count down loop for
                ' removing items from a collection. Otherwise,
                ' the loop counter gets confused and only every
                ' other item is removed.
                strFile = ""
                For i = lngCount To 1 Step -1
                    ' Save attachment before deleting from item.
                    ' Get the file name.
                    
                    strFile = strFile & objAttachments.Item(i).FileName & " - " & vbCrLf
           
                    
                    ' Save the attachment as a file.
                    objAttachments.Item(i).SaveAsFile (ilocation & objAttachments.Item(i))
                    
                    ' Save the attachment as a file.
                    ' objAttachments.Item(i).SaveAsFile strFile
                    ' Delete the attachment.
                    objAttachments.Item(i).Delete
                Next i
                strFile = "Attachment moved to: " & ilocation & strFile & vbCrLf & vbCrLf
                
                Dim objDoc As Object
                Dim objInsp As Outlook.Inspector
                Set objInsp = objMsg.GetInspector
                Set objDoc = objInsp.WordEditor
                
                
                objDoc.Characters(1).InsertBefore strFile
                ' objDoc.Save
                objMsg.HTMLBody = strFile + objMsg.HTMLBody
                
                Set objInsp = Nothing
                Set objDoc = Nothing
            End If
            strFile = strFile & vbCrLf & vbCrLf
            objMsg.Save
        End If
    Next
 
ExitSub:
    Set objAttachments = Nothing
    Set objMsg = Nothing
    Set objSelection = Nothing
    Set objOL = Nothing
End Sub

NicolBlog : 2007

How to remove attachments from outlook (2007) emails easily