Outlook VBA - How to empty the deleted items folder for specific mailboxes

[Karin]

Hi.
I am using Outlook 2016. I am trying to figure out the code to empty the Deleted Items folder for 2 specific mailboxes. I found some code on the internet, but I can't figure out how to change it so that it only processes the Deleted Items folders in the 2 specific mailboxes that I want. It goes through ALL mailboxes. This is the code I found:

Private Sub Application_Startup()
    Dim objStores As Outlook.Stores
    Dim objStore As Outlook.Store
    Dim objPSTFile As Outlook.Folder
    Dim objFolders As Outlook.Folders
    Dim objFolder As Object
 
    Set objStores = Outlook.Application.Session.Stores
 
    'Process all Outlook PST files in your Outlook
    For Each objStore In objStores
        Set objPSTFile = objStore.GetRootFolder
        For Each objFolder In objPSTFile.Folders
            Call ProcessFolders(objFolder)
        Next
    Next
End Sub

Sub ProcessFolders(ByVal objCurrentFolder As Outlook.Folder)
    Dim i, n As Long
 
    If objCurrentFolder.Name = "Deleted Items" Then
       'Delete all the items in "Deleted Items" folder
       For i = objCurrentFolder.Items.Count To 1 Step -1
           objCurrentFolder.Items.Item(i).Delete
 
           'Delete all the subfolders under "Deleted Items" folder
           For n = objCurrentFolder.Folders.Count To 1 Step -1
               objCurrentFolder.Folders.Item(n).Delete
           Next
       Next
    End If
End Sub

Can anyone help me with this problem?

Thanks!

Karin

[gmayor]

You need to conditionally process the stores e.g.

Private Sub Application_Startup()
Dim objStores As Outlook.Stores
Dim objStore As Outlook.Store
Dim objPSTFile As Outlook.Folder
Dim objFolders As Outlook.Folders
Dim objFolder As Object

    Set objStores = Outlook.Application.Session.Stores

    'Process all Outlook PST files in your Outlook
    For Each objStore In objStores
        Select Case objStore.DisplayName
            Case Is = "Name of Store1", "Name of Store2"
                Set objPSTFile = objStore.GetRootFolder
                For Each objFolder In objPSTFile.Folders
                    Call ProcessFolders(objFolder)
                Next objFolder
            Case Else
        End Select
    Next objStore

    Set objStores = Nothing
    Set objStore = Nothing
    Set objPSTFile = Nothing
    Set objFolders = Nothing
    Set objFolder = Nothing
End Sub

Where "Name of Store1", "Name of Store2" are the display names of the accounts you wish to process. If you are unsure what names to use, the following will list the store display names in the immediate window

Sub Test()
Dim objStores As Outlook.Stores
Dim objStore As Outlook.Store

    Set objStores = Outlook.Application.Session.Stores

    'Process all Outlook PST files in your Outlook
    For Each objStore In objStores
        Debug.Print objStore.DisplayName
    Next objStore

    Set objStores = Nothing
    Set objStore = Nothing
End Sub

[Aussiebear]

Well done Graham

[Karin]

Thanks Graham.
It works great. I want it to run when I open Outlook so I put the code in Application_Startup(). It doesn't run. Is there a different spot I should be putting it?
Thanks.
Karin

[gmayor]

Do you have application_startup in the ThisOutlookSession module? Did you save the macro when prompted on closing Outlook?

[Karin]

I moved it to ThisOutlookSession again. Last time I did that it disappeared. But it seems to have stayed put this time.
It is now working when I open Outlook, but... The problem is that Outlook will not open unless I open it with administrator privileges. Any idea why and how to fix?
Thanks.

[Aussiebear]

Are you able to run macros when not in Admin mode?