How to remove attachments from outlook emails easily

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 2003 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!

 

 

' by Nicola Delfino 30-03-2005
'   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 VBA
'          tools->digital signature-> (choose certificate)
' (3) add icon on toolbar
'          from outlook
'          tools->customize
'                add icon on toolbar
'                [rearrange commands] to change icon and name on toolbar
' (4) install [http://www.contextmagic.com/express-clickyes/]
' (5) be sure that tools->macros->security
'               on "thrusted publishers" "trust all installed add-ins and templates" is checked

 

 

 

Public Sub StripAttachments()
    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
   
    On Error Resume Next
   
    result = MsgBox("do you want to remove attachments from selected file?", vbYesNo + vbQuestion)
    If result = vbNo Then
        Exit Sub
    End If
   
    ' Instantiate an Outlook Application object.
    Set objOL = CreateObject("Outlook.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 strFile
                    ' Delete the attachment.
                    objAttachments.Item(i).Delete
                Next i
                strFile = strFile & "ATTACH REMOVED" & "-" & 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
               
               
            End If
            objMsg.Save
        End If
    Next

 

ExitSub:
    Set objAttachments = Nothing
    Set objMsg = Nothing
    Set objSelection = Nothing
    Set objOL = Nothing
End Sub