How to remove attachments from outlook (2007) emails easily

Artigo
10/22/2009

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

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

UPDATE (22/10/09) : Thanks to Steve Evans now it shows a link to folder where the attaches are saved

 ' by Nicola Delfino

'       30-03-2005: First version

'       26-11-2006: Updated for Outlook 2007

'       28-11-2006: Updated with notes from rgreg

'       09-06-2009: Saves the file(s) to a folder location (thanks to John Harvey and Patrick Philippot)

'                   Memory problem with many attach to remove (FIXED) (thanks to John Harvey and Patrick Philippot)

'       22-10-2009: Now it uses default "My document folder"

'                   added HTML and link to saved files (thanks to Steve Evans)

'   based on code found at on https://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

Private Declare Function SHGetFolderPath Lib "shell32.dll" Alias "SHGetFolderPathA" ( _

    ByVal HWnd As Long, ByVal csidl As Long, ByVal hToken As Long, ByVal dwFlags As Long, ByVal pszPath As String) As Long

Private Const MAX_PATH = 260&

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 = GetSpecialFolder(&H5) & "\Removed Attachs\" ' CSIDL_MY_DOCUMENTS As Long = &H5"

    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.

                    Dim strHTML As String

                    strHTML = "<li><a href=" & Chr(34) & "file:" & ilocation & objAttachments.Item(i).FileName & Chr(34) & ">" & objAttachments.Item(i).FileName & "</a><br>" & vbCrLf

                    strFile = strFile & strHTML

                    ' Save the attachment as a file.

                    objAttachments.Item(i).SaveAsFile (ilocation & objAttachments.Item(i))

                    ' Save the attachment as a file.

                    objAttachments.Item(i).Delete

                Next i

                strFile = "Attachment removed from the message and backup-ed to[<a href='" & ilocation & "'>" & ilocation & "</a>]:<br><ul>" & strFile & "</ul><hr><br><br>" & 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

                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

Public Function GetSpecialFolder(FolderCSIDL As Long) As String

    Dim HWnd As Long

    Dim Path As String

    Dim Res As Long

    Dim ErrNumber As Long

    Dim ErrText As String

    Path = String$(MAX_PATH, vbNullChar)

    ''''''''''''''''''''''''''''''''''''''''''''

    ' get the folder name

    ''''''''''''''''''''''''''''''''''''''''''''

    Res = SHGetFolderPath(HWnd:=0&, _

                            csidl:=FolderCSIDL, _

                            hToken:=0&, _

                            dwFlags:=0&, _

                            pszPath:=Path)

    Select Case Res

        Case S_OK

            Path = TrimToNull(Text:=Path)

            GetSpecialFolder = Path

        Case S_FALSE

            MsgBox "The folder code is valid but the folder does not exist."

            GetSpecialFolder = vbNullString

        Case E_INVALIDARG

            MsgBox "The value of FolderCSIDL is not valid."

            GetSpecialFolder = vbNullString

        Case Else

            ErrNumber = Err.LastDllError

            ErrText = "ERROR!"

            MsgBox "An error occurred." & vbCrLf & _

                "System Error: " & CStr(ErrNumber) & vbCrLf & _

                "Description:  " & ErrText

    End Select

End Function

Public Function TrimToNull(Text As String) As String

    Dim N As Long

    N = InStr(1, Text, vbNullChar)

    If N Then

        TrimToNull = Left(Text, N - 1)

    Else

        TrimToNull = Text

    End If

End Function

Comments

Anonymous
October 23, 2009
Hi Nicola, You Rock!!! This is excellent code...I am sharing it with everyone who wants it. By the way Outlook 2007 does let you save attachments - they just don't make it easy... Here's how:

Open the email with the attachment
Under the Actions group on the toolbar select Other Actions
Click Edit Message
You can then save/delete the attachment and resave the message without the attachment. Your code does this much better, move over Bill Gates, LOL. Thanks again, I will be referring to your page lots! Cheers! Connie

Anonymous
October 29, 2009
The comment has been removed
Anonymous
October 29, 2009
Great powerful script! Thanks $1M. Small correction required on the line following ' Save the attachment as a file. objAttachments.Item(i).SaveAsFile (ilocation & objAttachments.Item(i)) should be objAttachments.Item(i).SaveAsFile (ilocation & objAttachments.Item(i).FileName) Remind users to disable antivirus scanning during bulk removal of attachments from emails.
Anonymous
November 03, 2009
Great script, very nicely done! I've made the following modifications to fit our company’s needs:
Prompt if destination folder doesn't exist and create it.
Append a suffix if the filename already exists If can post the changes if anyone is intrested. Brian
Anonymous
November 04, 2009
Please post Brian:-)
Anonymous
November 05, 2009
Brian Please post that Nicola - great script stu
Anonymous
November 12, 2009
Please please Brian :) I'd love to know how to modify the tool to be asking for a file destination before saving intead of saving to a default folder? Thanks!
Anonymous
November 17, 2009
EXCELLENT script! easy to use. I'm a Noob Had problems except: ['Put in the folder location you want to save attachments to ilocation = GetSpecialFolder(&H5) & "Removed Attachs" ' CSIDL_MY_DOCUMENTS As Long = &H5" On Error Resume Next] Where should i paste the folder location? eg. C:Documents and Settings..Desktop...E-mail attachments backup Also, look forward to Brian's addition to "Append a suffix if the filename already exists"
Anonymous
November 26, 2009
Great script Nicola. Saves me the hassle of finding a pay version and it does it perfectly. The only thing people need to keep in mind, without Brian's adaption, you need to create %userprofile%My DocumentsRemoved Attachs or else the files go nowhere. Thanks to PlayaJ and JSadler for the update about the file extension.
Anonymous
November 29, 2009
Nicola this is excellent. Although I am not a programmer I have installed this and am using it. A great addition would be the date which the mail was created to avoid overwriting attachment files with the same name. This has been done by someone else. - see http://www.fontstuff.com/outlook/oltut01.htm. I don't have the skills to implement this unfortunately but it would be an excellent addition to a really good application.
Anonymous
December 03, 2009
Hi, Its really great..Thanks for shearing this. I have a doubt on this, how we will give macro name as "Remove Attachments", i mean how we can give this name for toolbar icon.
Anonymous
December 15, 2009
Can someone please submit a link or provide directions on how to install this in Office?
Anonymous
December 16, 2009
This is great. It saved me hours. If Brian would post his script or if someone accomplishes what was suggested by Trevor, please be sure to post.
Anonymous
January 05, 2010
The comment has been removed
Anonymous
January 14, 2010
Wow thanks a lot. This saved me hours and hours of work.
Anonymous
January 14, 2010
Spot on....!!! xclnt work Nicola...Thanks a Zillion :)

Partilhar via

How to remove attachments from outlook (2007) emails easily

Comments

Recursos adicionais