6 minute read

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
' 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.
                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
                objMsg.HTMLBody = strFile + objMsg.HTMLBody
            End If
        End If
    Set objAttachments = Nothing
    Set objMsg = Nothing
    Set objSelection = Nothing
    Set objOL = Nothing
End Sub