Clean up items in Outlook


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 '
''''' ' 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("\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("\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: ' 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("\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


Section contents

About Wim

Wim Gielis is a Business Intelligence consultant and Excel expert

Other links