Clean up items in Outlook

  • Nov. 8, 2016

Introduction

A small sidestep to Outlook… I also use macros in Outlook to speed up my work and get rid of repetitive, brains-killing gestures. One of these actions is cleaning up the folders like Deleted items and junk mail.

Below I show you the macro that I use to automatically clean up 3 folders, without messages from Outlook, just clean up/empty the folders:

  • Deleted items folder
  • junk mail folder
  • the folder that I call: ZZ_Cleaned up

That last folder deserves some explanations. Within Outlook there is a possibility to delete "duplicate" emails / redundant messages. "Duplicate" emails are those emails in a conversation, whereby people reply and leave the original message at the bottom of the message. Obviously this piles up as the conversation continues and soon the emails become big. If you only keep the last one of the emails, it's good - you don't need copies of copies of emails. Whenever an email contains an attachment, the message is not redundant and will not be deleted. Well, those redundant emails can be moved to a certain folder. When this happens it's your task to delete the redundant emails in that folder again. That is the action that I mean above.

VBA code

Here's code to clean up all items and folders in those 3 folders: 

Sub RemoveDeletedItems()


' Wim Gielis
' https://www.wimgielis.com


'''''
' Code to clean up folders in Outlook
' 08/11/16
'''''

    Dim oJunkItems            As Outlook.Folder
    Dim oDeletedItems         As Outlook.Folder
    Dim oCleanedUpItems       As Outlook.Folder

    On Error Resume Next

    'Junk E-mail
    Set oJunkItems = Application.Session.GetDefaultFolder(23)    'olFolderJunk = 23
    CleanUp oJunkItems

    'Deleted Items
    Set oDeletedItems = Application.Session.GetDefaultFolder(3)    'olFolderDeletedItems = 3
    CleanUp oDeletedItems

    'ZZ_Cleaned up
    Set oCleanedUpItems = GetFolderPath("wgielis@aexis.com\Customers\TM1\ZZ_Cleaned up")
    CleanUp oCleanedUpItems

    On Error GoTo 0


End Sub



Sub CleanUp(fld As Outlook.Folder)

    Dim oFolders              As Outlook.Folders
    Dim oItems                As Outlook.Items
    Dim i                     As Long

    Set oItems = fld.Items
    For i = oItems.Count To 1 Step -1
        oItems.Item(i).Delete
    Next

    Set oFolders = fld.Folders
    For i = oFolders.Count To 1 Step -1
        oFolders.Item(i).Delete
    Next


End Sub

Readers paying attention will have seen that 2 out of 3 folders can be targeted in Outlook in a standard way. These are built-in in Outlook: 

    Set oJunkItems = Application.Session.GetDefaultFolder(23)    'olFolderJunk = 23
    Set oDeletedItems = Application.Session.GetDefaultFolder(3)    'olFolderDeletedItems = 3

The folder that I created myself is harder to approach: 

    Set oCleanedUpItems = GetFolderPath("wgielis@aexis.com\Customers\TM1\ZZ_Cleaned up")

Hence the need to have code to find that folder object based on its name: 

Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder


    'source to find the path to a folder:
    'http://www.outlook-tips.net/how-to/find-folder-path-in-mailbox/

    Dim oFolder               As Outlook.Folder
    Dim FoldersArray          As Variant
    Dim i                     As Integer
	Dim SubFolders            As Outlook.Folders

    On Error GoTo GetFolderPath_Error
    If Left(FolderPath, 2) = "\\" Then
        FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    'Convert folderpath to array
    FoldersArray = Split(FolderPath, "\")
    Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
    If Not oFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)

            Set SubFolders = oFolder.Folders
            Set oFolder = SubFolders.Item(FoldersArray(i))
            If oFolder Is Nothing Then
                Set GetFolderPath = Nothing
            End If
        Next
    End If
    'Return the oFolder
    Set GetFolderPath = oFolder
    Exit Function

GetFolderPath_Error:
    Set GetFolderPath = Nothing
    Exit Function


End Function

For those of you who want a shorter version of the macro "RemoveDeletedItems", you could use this: 

Sub RemoveDeletedItems()

    On Error Resume Next

    'Junk E-mail
    CleanUp Application.Session.GetDefaultFolder(23)    'olFolderJunk = 23

    'Deleted Items
    CleanUp Application.Session.GetDefaultFolder(3)    'olFolderDeletedItems = 3

    'ZZ_Cleaned up
    CleanUp GetFolderPath("wgielis@aexis.com\Customers\TM1\ZZ_Cleaned up")

    On Error GoTo 0


End Sub

I assign this macro to an icon in my QAT and I'm finished ! :-)

Finally I automatically execute this macro each time Outlook starts. Add this code with ThisOutlookSession: 

Private Sub Application_Startup()


    'start Outlook in an organized way
    RemoveDeletedItems


End Sub



Homepage

Section contents

About Wim

Wim Gielis is a Business Intelligence consultant and Excel expert

Other links