Outlook attachment removal macro

You can remove attachments in Outlook simply by opening the message, right-clicking the attachment, and choosing remove. This won't work in the preview pane, but will when the message is open. Another option is to setup and use this macro, which will remove all attachments (including embedded ones) and leave their file names so you can more easily find them later. You can add it as a button to your Outlook toolbar, and just click on it whenever you need it. I use it quite a bit to keep from having attachments all over, and originally found the information here. You can even remove attachments from multiple messages with a single press of the button. Here are instructions and the code for doing this in Outlook 2003. I use it in Outlook 2007, but the setup steps may be slightly different:

1. Go to Start->All Programs->Microsoft Office->Microsoft Office Tools->Digital Certificates for VBA Projects

2. You will be asked to name your certificate. This name can be whatever you choose, as long as you remember what you pick. Something such as “remove” or “attachment” are two options that will make it easier to find when you need it. You should get a notification that the certificate was created successfully.

3.  Now open Outlook. Go to Tools->Macros->Visual Basic Editor.

4. In the top left, in the Project area, expand “Project1”, then expand “Microsoft Office Outlook Objects”. This should give you “ThisOutlookSession”. Double-clicking on “ThisOutlookSession” should open a text input window to the right.

5. Now, copy the text from the bottom of this post, starting with "Public Sub Strip()" to the "EndSub" at the very bottom.

6. Go back to “ThisOutlookSession”, click in the input box, then press Ctrl+V (paste the text you copied into this box). This will fill the input box with the text that had been in outlook.txt.

7. Now go to Tools->Digital Signature… In the “Sign as” section, select Choose. Here you should see the certificate you created in step #2. Select it and click OK. Now it should appear in the “Certificate Name:” area. If it does, press OK.

8. Go to Debug->Compile Project1. This will make your macro into a working program. You won’t notice it doing anything, but it is. After clicking Compile, go ahead and exit the Visual Basic editor. This will bring you back to Outlook. If asked to save changes, choose yes.

9. Now you need to add the button to your Outlook window. To do this, go to View->Toolbars->Customize. Choose the Commands tab, then go to the Macros category. Here you should see your macro. Click on it and drag it to an active toolbar.

10. That’s it. Now when you have an attachment you no longer need, but you’d like to retain the email simply go to that email and click the button you just added. It will ask if you’re sure that you want to delete the attachment. Click OK and there you go.

Public Sub Strip()

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

            strFile = strFile & vbCrLf & vbCrLf

            objMsg.Save

        End If

    Next

ExitSub:

    Set objAttachments = Nothing

    Set objMsg = Nothing

    Set objSelection = Nothing

    Set objOL = Nothing

End Sub