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 SubWhere "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?