Tuesday, December 16, 2008

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

2 comments:

Anonymous said...

Hi and thanks for the macro! It worked at least once and now it only deletes the attachment. How may I get it to save the file as well?

Hey - many thanks for your help!!

Faye

Anonymous said...

You need to replace '& vbCrLf' in this code by '&"< b r >"'(without space), to have carriage returns.

ie.
'strFile = strFile & objAttachments.Item(i).FileName & vbCrLf
strFile = strFile & objAttachments.Item(i).FileName & "< b r >"(without space)

BR,
Hiro