Permanently Delete MailMessage in Outlook with VBA? - vba

Question

I am looking for a way to permanently delete a MailMessage from Outlook 2000 with VBA code. I'd like to do this without having to do a second loop to empty the Deleted items.
Essentially, I am looking for a code equivalent to the UI method of clicking a message and hitting SHIFT+DELETE.
Is there such a thing?

Answer 1

Try moving it first then deleting it (works on some patchs in 2000) or use RDO or CDO to do the job for you (you will have to install them)
Set objDeletedItem = objDeletedItem.Move(DeletedFolder)
objDeletedItem.Delete
CDO way
Set objCDOSession = CreateObject("MAPI.Session")
objCDOSession.Logon "", "", False, False
Set objMail = objCDOSession.GetMessage(objItem.EntryID, objItem.Parent.StoreID)
objMail.Delete
RDO
set objRDOSession = CreateObject("Redemption.RDOSession")
objRDOSession.MAPIOBJECT = objItem.Session.MAPIOBJECT
set objMail = objRDOSession.GetMessageFromID(objItem.EntryID>)
objMail.Delete
You could also mark the message first before you delete it and the loop through the deleted items folder and find it an dthe call delete a second time. Mark it using a Userproperty.
objMail.UserProperties.Add "Deleted", olText
objMail.Save
objMail.Delete
loop through you deleted items look for that userprop
Set objDeletedFolder = myNameSpace.GetDefaultFolder(olFolderDeletedItems)
For Each objItem In objDeletedFolder.Items
Set objProperty = objItem.UserProperties.Find("Deleted")
If TypeName(objProperty) <> "Nothing" Then
objItem.Delete
End If
Next

Answer 2

Simplest solution of all, similar to the first way:
FindID = deleteme.EntryID
deleteme.Delete
set deleteme = NameSpace.GetItemFromID(FindID)
deleteme.Delete
Do it twice and it'll be gone for good, and no performance killing loop. (NameSpace can be a particular namespace variable, if not in the default store.) Note this only works if you don't delete across stores, which can change the EntryID or remove it entirely.

Answer 3

I know this is an old thread, but since I recently had cause to write a macro that does this, I thought I'd share. I found that the Remove method appears to be a permanent deletion. I'm using this snippet:
While oFilteredItems.Count > 0
Debug.Print " " & oFilteredItems.GetFirst.Subject
oFilteredItems.Remove 1
Wend
I begin with a list of items that have been filtered by some criteria. Then, I just delete one at a time until it's gone.
HTH

Answer 4

You can use the following approach, basically you delete all of your email messages as you are currently doing, then call this one line to empty the deleted items folder. The code is in jscript, but I can translate if you really need me to :)
var app = GetObject("", "Outlook.Application"); //use new ActiveXObject if fails
app.ActiveExplorer().CommandBars("Menu Bar").Controls("Tools").Controls('Empty "Deleted Items" Folder').Execute();

Answer 5

Recently I had to permamentnly delete all contacts. This worked for me (Outlook 2016). You have obtain new reference to the item in the trash folder, otherwise it says "already deleted" or something like that. Just go from the end and the recently moved items will be there. Then calling Delete achieves permanent deletion. This snippet can be used in a loop.
myContacts(i).Move (trashFolder)
trashCount = trashFolder.Items.Count
For j = trashCount To 1 Step -1
Set trashItem = trashFolder.Items(j)
If trashItem.MessageClass = "IPM.Contact" Then
trashItem.Delete
Else
Exit For
End If
Next