Home » Purge empty Ms Outlook Folders with VBA

I was recently spotted an opportunity to flex my VBA muscles when Richard Tubb posted a tweet, asking for solutions on how to clear out unused Microsoft Outlook folders.

I decided to accept the challenge, and threw together the following VBA Sub

'****************************************************************************************
'****************************************************************************************
'******
'****** Name: Purge empty outlook mail folders
'****** Description: Search Outlook Inbox subfolders and remove any unused
'****** Date: 30/12/2010
'****** Author: Mike Hudson - http://www.mikesel.info
'******
'****************************************************************************************
'****************************************************************************************
Public Sub FolderPurge()
Dim myToplvl As Folders 'Declare top level folder object
Dim myFldr As Folder 'Declare sub folder objects Set myToplvl = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders 'Set top level folder as Outlooks Inbox subfolders
For Each myFldr In myToplvl 'Sweep through each folder under the inbox
If myFldr.Items.Count < 1 Then 'If the folder is empty check for subfolders
If myFldr.Folders.Count < 1 Then 'If the folder contains not sub folders confirm deletion
response = MsgBox(myFldr.Name & " contains no items, would you like to delete it?", vbYesNo)
If response = vbYes Then 'If response is yes
myFldr.Delete 'Delete the folder
End If
Else 'Folder contains sub folders so confirm deletion
response = MsgBox(myFldr.Name & " contains no items but does contain subfolders, would you like to delete it?", vbYesNo)
If response = vbYes Then 'If response is yes
myFldr.Delete 'Delete folder and it's sub folders
End If
End If
Else 'Folder contains items so leave alone.
Debug.Print myFldr.Name & " contains items so would be left alone"
End If
Next
End Sub

As you can see from the code, this sub does exactly what is required. However, Richard threw me a bit of a curve ball and asked for it to be modified to allow the end user to choose there own folder to scan. Which is when I went back to the drawing board and came up with his little number:

'****************************************************************************************
'****************************************************************************************
'******
'****** Name: Purge empty outlook mail folders
'****** Description: Search Outlook Inbox subfolders and remove any unused
'****** Date: 30/12/2010
'****** Author: Mike Hudson - http://www.mikesel.info
'******
'****************************************************************************************
'****************************************************************************************
Public Sub FolderPurge()
Dim myToplvl As Folders 'Declare top level folder object
Dim myFldr As Folder 'Declare sub folder objects Set myToplvl = Outlook.GetNamespace("MAPI").PickFolder.Folders
For Each myFldr In myToplvl 'Sweep through each folder under the inbox
If myFldr.Items.Count < 1 Then 'If the folder is empty check for subfolders
If myFldr.Folders.Count < 1 Then 'If the folder contains not sub folders confirm deletion
response = MsgBox(myFldr.Name & " contains no items, would you like to delete it?", vbYesNo)
If response = vbYes Then 'If response is yes
myFldr.Delete 'Delete the folder
End If
Else 'Folder contains sub folders so confirm deletion
response = MsgBox(myFldr.Name & " contains no items but does contain subfolders, would you like to delete it?", vbYesNo)
If response = vbYes Then 'If response is yes
myFldr.Delete 'Delete folder and it's sub folders
End If
End If
Else 'Folder contains items so leave alone.
Debug.Print myFldr.Name & " contains items so would be left alone"
End If
Next
End Sub

This variation pops up Microsoft’s own ‘Folder Chooser’ allowing the user to choose their own starting point.

Hopefully someone will find this snippet useful.

Should you require assistance implementing this script, or modifying it please feel free to get in touch.

Home » Purge empty Ms Outlook Folders with VBA


  • http://www.x-ray-technician-guide.com x-ray technician

    Beneficial info and excellent design you got here! I want to thank you for sharing your ideas and putting the time into the stuff you publish! Great work!

  • ed

    Mike,

    I see your code, where do I put it and how do I execute it?

    • ed

      Dang security question!!!!

      for the 4th time, works great.

      Outlook 2010
      File – Options – Customize Ribbon – check Developer

      Go to Developer page, make a visual Basic module, remove your html portions, change the italic ‘ and ” and it works perfect.

    • Mike Hudson

      Yeah sorry about the random HTML stuff, I am just in the process of porting over from Joomla to WordPress and I am yet to tidy up the code..

      Glad you got it working ok!

      • http://twitter.com/asadjobanputra Asad Jobanputra

        I updated the script so it will recurse through sub-folders and analyze sub-folders automatically.

        See script below:Private Sub CommandButton1_Click()
        Dim mytoplvl As Folders
        Set mytoplvl = Outlook.GetNamespace(“MAPI”).PickFolder.Folders

        FolderPurge mytoplvl
        End Sub
        ‘****************************************************************************************
        ‘****************************************************************************************
        ‘******
        ‘****** Name: Purge empty outlook mail folders
        ‘****** Description: Search Outlook Inbox subfolders and remove any unused
        ‘****** Date: 30/12/2010
        ‘****** Author: Mike Hudson – http://www.mikesel.info
        ‘******
        ‘****************************************************************************************
        ‘****************************************************************************************
        Public Sub FolderPurge(mytoplvl As Folders)
        Dim myFldr As Folder ‘Declare sub folder objects

        Debug.Print “Analyzing: ” & mytoplvl.GetFirst.Name

        For Each myFldr In mytoplvl ‘Sweep through each folder under the inbox
            If myFldr.Items.Count < 1 Then 'If the folder is empty check for subfolders
                If myFldr.Folders.Count < 1 Then 'If the folder contains not sub folders confirm deletion
                    Debug.Print myFldr.Name & " contains no items, and will be deleted."
                    myFldr.Delete 'Delete the folder
                Else 'Folder contains sub folders so confirm deletion
                    FolderPurge myFldr.Folders
                End If
                
            Else 'Folder contains items so leave alone.
                Debug.Print myFldr.Name & " contains items so would be left alone"
            End If
        Next
        End Sub

        • http://www.mikesel.info/ Mike Hudson

          Looks good Asad thanks for sharing

        • https://me.yahoo.com/t4meb0y#b9b56 Guest

           thanks for this modification, worked a treat!

  • http://twitter.com/asadjobanputra Asad Jobanputra

    I updated the script so it will recurse through sub-folders and analyze sub-folders automatically.

    See script below:Private Sub CommandButton1_Click()
    Dim mytoplvl As Folders
    Set mytoplvl = Outlook.GetNamespace(“MAPI”).PickFolder.Folders

    FolderPurge mytoplvl
    End Sub
    ‘****************************************************************************************
    ‘****************************************************************************************
    ‘******
    ‘****** Name: Purge empty outlook mail folders
    ‘****** Description: Search Outlook Inbox subfolders and remove any unused
    ‘****** Date: 30/12/2010
    ‘****** Author: Mike Hudson – http://www.mikesel.info
    ‘******
    ‘****************************************************************************************
    ‘****************************************************************************************
    Public Sub FolderPurge(mytoplvl As Folders)
    Dim myFldr As Folder ‘Declare sub folder objects

    Debug.Print “Analyzing: ” & mytoplvl.GetFirst.Name

    For Each myFldr In mytoplvl ‘Sweep through each folder under the inbox
        If myFldr.Items.Count < 1 Then 'If the folder is empty check for subfolders
            If myFldr.Folders.Count < 1 Then 'If the folder contains not sub folders confirm deletion
                Debug.Print myFldr.Name & " contains no items, and will be deleted."
                myFldr.Delete 'Delete the folder
            Else 'Folder contains sub folders so confirm deletion
                FolderPurge myFldr.Folders
            End If
            
        Else 'Folder contains items so leave alone.
            Debug.Print myFldr.Name & " contains items so would be left alone"
        End If
    Next
    End Sub

    • http://www.mikesel.info/ Mike Hudson

      Looks good Asad thanks for sharing

  • Michael Waybright

    Updated to check subfolders of folders with contents.

    ‘************************************************************************************************’****** Name: Empty Folder Cleanup’****** Description: Select high level folder. 
    ‘****** Check all subfolders and purge empty subfolders.’****** Author: Mike Hudson – http://www.mikesel.info * Date: 30/12/2010′****** Revision Author: Michael Waybright * Date: 25/10/2012′************************************************************************************************Sub EmptyFolderPurge()Dim mytoplvl As FoldersDim Purge_Flag As Boolean
    Set mytoplvl = Outlook.GetNamespace(“MAPI”).PickFolder.FoldersPurge_Flag = True
    Do While Purge_Flag    Purge_Flag = False    FolderPurgev2 mytoplvl, Purge_FlagLoop    End Sub’************************************************************************************************’****** Name: Empty Folder Cleanup’****** Description: Select high level folder. 
    ‘****** Check all subfolders and purge empty subfolders.’****** Author: Mike Hudson – http://www.mikesel.info * Date: 30/12/2010′****** Revision Author: Michael Waybright * Date: 25/10/2012′************************************************************************************************Public Sub FolderPurgev2(mytoplvl As Folders, Purge_Flagv2 As Boolean)Dim myFldr As Folder ‘Declare sub folder objects
    For Each myFldr In mytoplvl ‘Sweep through each folder under the inbox    If myFldr.Folders.Count > 0 Then ‘If the folder contains sub folders check for empty        FolderPurgev2 myFldr.Folders, Purge_Flagv2 ‘Check sub folders for empty folders    End If
        If myFldr.Items.Count < 1 And myFldr.Folders.Count < 1 Then 'If the folder is empty and no subfolders then deletion        myFldr.Delete 'Delete the folder        Purge_Flagv2 = True    End IfNextEnd Sub

    • http://www.mikesel.info/ Mike Hudson

      Thanks Michael

      Thats pretty impressive.

      Thanks for taking the time to share your code.

  • Anonymous

    It is possible to have a little help here ?
    ive tried your vbamacro, and it is not working.

    I run it, but empty folder are still present

  • Anonymous

    Hello, it is possible to have a little help here ?
    Ive tried to use your Vb Macro to delete all folder that are empty in my outlook 2010 mailbox..

    but Ive not been really successful, on run i get error 424 line :
    For Each myFldr In myToplvl ‘Sweep through each folder under the inbox

    think you could gimme a hand ?

    Thank you.

    Gh0stID

    • http://www.mikesel.info/ Mike Hudson

      Hello gh0stid

      I don’t have Ol 2010 to test the code with, however I am currently in the process of rewriting it into an outlook add-in. Once this is done I will post a blog, and maybe the add-in will work better for you.

      Thanks
      Mike

  • gh0stid

    Hello, it is possible to have a little help here ?
    Ive tried to use your Vb Macro to delete all folder that are empty in my outlook 2010 mailbox..

    but Ive not been really successful, on run i get error 424 line :
    For Each myFldr In myToplvl ‘Sweep through each folder under the inbox

    think you could gimme a hand ?

    Thank you.

    Gh0stID

    • http://www.mikesel.info/ Mike Hudson

      Hello gh0stid

      I don’t have Ol 2010 to test the code with, however I am currently in the process of rewriting it into an outlook add-in. Once this is done I will post a blog, and maybe the add-in will work better for you.

      Thanks
      Mike

  • Pingback: URL

  • Michael Waybright

    Updated to check subfolders of folders with contents.

    ‘************************************************************************************************’****** Name: Empty Folder Cleanup’****** Description: Select high level folder. 
    ‘****** Check all subfolders and purge empty subfolders.’****** Author: Mike Hudson – http://www.mikesel.info * Date: 30/12/2010′****** Revision Author: Michael Waybright * Date: 25/10/2012′************************************************************************************************Sub EmptyFolderPurge()Dim mytoplvl As FoldersDim Purge_Flag As Boolean
    Set mytoplvl = Outlook.GetNamespace(“MAPI”).PickFolder.FoldersPurge_Flag = True
    Do While Purge_Flag    Purge_Flag = False    FolderPurgev2 mytoplvl, Purge_FlagLoop    End Sub’************************************************************************************************’****** Name: Empty Folder Cleanup’****** Description: Select high level folder. 
    ‘****** Check all subfolders and purge empty subfolders.’****** Author: Mike Hudson – http://www.mikesel.info * Date: 30/12/2010′****** Revision Author: Michael Waybright * Date: 25/10/2012′************************************************************************************************Public Sub FolderPurgev2(mytoplvl As Folders, Purge_Flagv2 As Boolean)Dim myFldr As Folder ‘Declare sub folder objects
    For Each myFldr In mytoplvl ‘Sweep through each folder under the inbox    If myFldr.Folders.Count > 0 Then ‘If the folder contains sub folders check for empty        FolderPurgev2 myFldr.Folders, Purge_Flagv2 ‘Check sub folders for empty folders    End If
        If myFldr.Items.Count < 1 And myFldr.Folders.Count < 1 Then 'If the folder is empty and no subfolders then deletion        myFldr.Delete 'Delete the folder        Purge_Flagv2 = True    End IfNextEnd Sub

  • http://www.mikesel.info/ Mike Hudson

    Thanks Michael

    Thats pretty impressive.

    Thanks for taking the time to share your code.


Page 1 of 11