Sub EmptyDeletedItems()
‘Empties the default Mailbox Deleted Items Folder along with
‘the Deleted Items folder in multiple Personal Folders / PSTs
‘ 11/11/11 -dg- found this on http://sabarish.net/blog/archives/437

On Error GoTo ErrorHandler

Dim objOutlookApp As Outlook.Application
Dim mNameSpace As NameSpace
Dim objExpl As Outlook.Explorer
Dim objCBB As CommandBarButton
Dim strEntryID As String
Dim strStoreID As String

Set objOutlookApp = CreateObject(“Outlook.Application”)
Set mNameSpace = objOutlookApp.GetNamespace(“MAPI”)
‘Set the explorer to the active explorer
Set objExpl = objOutlookApp.ActiveExplorer
‘Capture the original current folder Entry and Store ID’s
strEntryID = objExpl.CurrentFolder.EntryID
strStoreID = objExpl.CurrentFolder.StoreID

‘***Empty Main Deleted Items Folder
‘Change the current folder to the target folder
Set objExpl.CurrentFolder = mNameSpace.GetDefaultFolder(olFolderDeletedItems)
‘Select the target folder
objExpl.SelectFolder mNameSpace.GetDefaultFolder(olFolderDeletedItems)
‘Get the Empty Deleted Items command = UID 1671
Set objCBB = objExpl.CommandBars.FindControl(, 1671)
‘Execute the command
objCBB.Execute

‘***Empty Personal Folders Deleted Items Folder
‘***Copy this section as many times as there are the number of
‘***different personal folders. -dg
‘Change the current folder to the target personal folder / pst name
Set personalFolder = mNameSpace.Folders(“1 – PES Email”) ‘Friends is the name of the Personal Folder
Set objExpl.CurrentFolder = personalFolder.Folders(“Deleted Items”)
‘Select the target folder
objExpl.SelectFolder personalFolder.Folders(“Deleted Items”)
‘Get the Empty Deleted Items command = UID 1671
Set objCBB = objExpl.CommandBars.FindControl(, 1671)
‘Execute the command
objCBB.Execute

‘***Empty Personal Folders Deleted Items Folder
‘Change the current folder to the target personal folder / pst name
Set personalFolder = mNameSpace.Folders(“2 – non PES Email”) ‘Family is the name of the Personal Folder
Set objExpl.CurrentFolder = personalFolder.Folders(“Deleted Items”)
‘Select the target folder
objExpl.SelectFolder personalFolder.Folders(“Deleted Items”)
‘Get the Empty Deleted Items command = UID 1671
Set objCBB = objExpl.CommandBars.FindControl(, 1671)
‘Execute the command
objCBB.Execute

‘Return to the original folder
Set objExpl.CurrentFolder = mNameSpace.GetFolderFromID(strEntryID, strStoreID)

ExitHere:
On Error Resume Next
Set objCBB = Nothing
Set objExpl = Nothing
Set mNameSpace = Nothing
Set objOutlookApp = Nothing
Set personalFolder = Nothing
Exit Sub
ErrorHandler:
Resume ExitHere
End Sub
=================================================
Is there something else I should look at to determine why this is suddenly not working?
Also, one time when I ran it, it MOVED a folder into the main Deleted Items folder without deleting it. I did NOT want the folder moved or deleted.
Thanks.

Tools>Options>Other>Advanced Options>

Uncheck “Warn before permenantly deleting items.”

Best

Thanks for bringing that to my notice! I had actually uploaded the wrong code. For representational purposes I had copied and pasted that repeating section from the main deleted items folder and forgot to change the values. I’ve uploaded the new version now.

You don’t need to loop through all files – you can do a select all (ID 756) and delete (ID 478) directly.

Cheers,
Sab

I came across your article when I decided to create separate PST files for each email account and realized there isn’t a logical way to remove deleted emails. Thanks to your code I managed to deal with the problem quite quickly..

but I’m wondering if you actually tested your code and it was working for you?

You are calling UID 1671 which is the main Empty “Deleted Items” Folder and as such it’s emptying only the default account, no matter if you selected another one.

So the solution is to enter the respective deleted items folder, loop through it and remove all items.

I thought I’d let you know ;)

-src-