VBA script or macro to remove attachments in Outlook

I'm new to VBA and macros is Office so I will need step by step help with a VBA script or a macro to remove attachments from a large amount of emails in Outlook and preferably save them to a folder specified in the script. Also I would want to specify the date ranges and all folders e.g. inbox, sent items, deleted

Any ideas?
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

David LeeCommented:
Hi, Gerhardpet.

This should do it.  Follow these instctions to add the code to Outlook.

1.  Start Outlook
2.  Click Tools > Macro > Visual Basic Editor
3.  If not already expanded, expand Microsoft Office Outlook Objects
4.  If not already expanded, expand Modules
5.  Select an existing module (e.g. Module1) by double-clicking on it or create a new module by right-clicking Modules and selecting Insert > Module.
6.  Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook's VB Editor window
7.  Edit the code as needed.  I included comments wherever something needs to or can change
8.  Click the diskette icon on the toolbar to save the changes
9.  Close the VB Editor

To use this

1.  Select a folder
2.  Run the macro
3.  Enter the starting and ending dates
Sub RemoveAttachments()
    Const MACRO_NAME = "Remove Attachments"
    Dim strStart As String, _
        strEnd As String, _
        strFolder As String, _
        olkFolder As Outlook.MAPIFolder, _
        olkItem As Object, _
        intCount As Integer, _
        intMsgsInDateRange As Integer, _
        intItemsWithAttachments As Integer, _
        intAttachmentsRemoved As Integer
    strStart = Format(InputBox("Enter the start date (DD/MM/YYYY:)"), "ddddd")
    strEnd = Format(InputBox("Enter the end date (DD/MM/YYYY:)"), "ddddd")
    On Error Resume Next
    If (Not IsDate(strStart)) Or (Not IsDate(strEnd)) Then
        MsgBox "No date entered.  Run again and enter a date.", vbCritical + vbOKOnly, MACRO_NAME & " - Error"
        'Change the folder path on the next line.  This is the folder that attachments will be saved to.'
        strFolder = "H:\Attachments\"
        Set olkFolder = Application.ActiveExplorer.CurrentFolder
        For Each olkItem In olkFolder.Items
            With olkItem
                'Change the dates on the next line as desired
                If (.ReceivedTime >= strStart) And (.ReceivedTime <= strEnd) Then
                    intMsgsInDateRange = intMsgsInDateRange + 1
                    If .Attachments.Count > 0 Then
                        intItemsWithAttachments = intItemsWithAttachments + 1
                        For intCount = .Attachments.Count To 1 Step -1
                            .Attachments.Item(intCount).SaveAsFile strFolder & _
                            intAttachmentsRemoved = intAttachmentsRemoved + 1
                    End If
                End If
            End With
        If intMsgsInDateRange = 0 Then
            MsgBox "All done.  There were no messages in the date range specified.", vbInformation + vbOKOnly, MACRO_NAME
            MsgBox "All done!" & vbCrLf & "We removed " & intAttachmentsRemoved & " attachments from " & _
                intItemsWithAttachments & " items.", vbInformation + vbOKOnly, MACRO_NAME
        End If
    End If
    On Error GoTo 0
    Set olkItem = Nothing
    Set olkFolder = Nothing
End Sub

Open in new window


Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
GerhardpetAuthor Commented:
This works great!

Here are a few things for the wish list. I would like to create a shortcut for the user to run this script on their own
1- Have a progress bar
2- An option so that the user can browse for the folder were to save the attachments
3- The date selectors have them with a mini calendar to select the dates from

If you have time for the above I would appreciate it

Regardless I will award you the points and thank for your help on this BlueDevilFan!
David LeeCommented:
The shortcut is easy.  You can add a toolbar button that runs the script by following these instructions.

1.  Click View > Toolbars > Customize
2.  Click the Toolbars tab
3.  Click New
4.  Name the toolbar
5.  Click the Commands tab
6.  Under Categories click Macros
7.  Under Commands click and hold on the macro, then drag it out and drop it on the new toolbar
8.  Dock the toolbar somewhere onscreen

For the other three, I'm Sorry but you're talking about more of a full-fledged application.  I'm not willing to undertake that.
GerhardpetAuthor Commented:
Ok. Thank you for you help anyway. I will just do that for the user then. I didn't know how much work that would be.
David LeeCommented:
I understand.  For whatever it's worth, the other three involve developing two forms, one to select the folder and set the dates, and another to show the progress.  Developing forms is always a cause for concern because they require installation (additional instructions and potential problems) and there's always the possibility of a mismatch between the form controls I have available to me and those available on the user's computer.  If we don't have the same controls, then the forms won't work and that will lead to additional time trying to isolate which controls are the problem and developing a workaround.  
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today

From novice to tech pro — start learning today.