Delete all items in Deleted Items folder or Permanently delete a message

[XxLicherxX]

Hello everyone,

I am wondering if someone can tell me how I can empty the Deleted Items
Folder using VBA. I have found a few examples on the web, but none of
the have worked.

If this is not possible to do, is they a way to permanently delete them
from the inbox (So the never reach the deleted items folder) ?

Thanks for your help.

 

[Guest]

To permanently delete a message in the Outlook interface, hold down the Shift
key while clicking the Delete button or pressing the Delete key.

To do this with code, you need to use CDO. This macro will permanently
delete the currently selected items:

Sub PermanentlyDeleteSelectedMessges()
On Error GoTo PermanentlyDeleteSelectedMessges_Error

Dim objSession As New MAPI.Session
Dim objSelection As Outlook.Selection
Dim objItem As Object
Dim objMAPIMessage As MAPI.Message 'Requires reference to the Microsoft
CDO 1.21 Library

'To permanently delete currently selected item(s) in active folder
objSession.Logon , , , False
Set objSelection = ActiveExplorer.Selection

If objSelection Is Nothing Or objSelection.Count = 0 Then Exit Sub
For Each objItem In objSelection
Set objMAPIMessage = objSession.GetMessage(objItem.EntryID)
'Permanently delete
objMAPIMessage.Delete False
Next

Leave:
If Not objSession Is Nothing Then objSession.Logoff
Set objSession = Nothing
Set objSelection = Nothing
Set objItem = Nothing
Set objMAPIMessage = Nothing

On Error GoTo 0
Exit Sub

PermanentlyDeleteSelectedMessges_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure
PermanentlyDeleteSelectedMessges of Module basExamples"
End Sub

If you want to empty the Deleted items folder, you don't need to use CDO
because if you delete these messages again they're gone forever. This macro
will empty the Deleted Items folder:

Sub EmptyDeletedItemsFolder()
On Error GoTo EmptyDeletedItemsFolder_Error

Dim objItem As Object, objItems As Outlook.Items
Dim objDelItemsFolder As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace
Dim intX As Integer

Set objNS = Application.GetNamespace("MAPI")
Set objDelItemsFolder = objNS.GetDefaultFolder(olFolderDeletedItems)
Set objItems = objDelItemsFolder.Items
For intX = objItems.Count To 1 Step -1
Set objItem = objItems.Item(intX)
'Permanently delete
objItem.Delete
Next

Set objItem = Nothing
Set objItems = Nothing
Set objDelItemsFolder = Nothing
Set objNS = Nothing

On Error GoTo 0
Exit Sub

EmptyDeletedItemsFolder_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure
EmptyDeletedItemsFolder of Module basExamples"
End Sub

 

[XxLicherxX]

Hi Eric,

That was helpful. Thanks for your response.

Dave.