Macro to identify deleted items w/IMAP and Outlook

[jdope225]

Hello,

I am trying to find a way to identify deleted items in outlook using IMAP. As you know when using IMAP and outlook when you delete a mail item, it puts a line through the item signifying that it is deleted, then you purge the folder to permanently delete all deleted items from the server and hence removes them from your Inbox. What I want to do is run a maro that identifies all deleted items, moves them to a different folder (ie. a "deleted items" folder) and then purge the current folder. Essentially this will give a deleted items folder, with a clean Inbox.

I can take care of moving and purging the emails, what I can't figure out is how to identify what messages are marked for deletion????

I either need a way to determine if an item is marked for deletion or a way to determine when the delete button has been pressed so I can run code at that time.

Can anyone help with this? It's driving me nuts!!

[jdope225]

Ok, so I finally figured this out. I would have assumed this would be a common bit of code, but I guess not. Using a reference to Redemption.dll I was able to access extended properties to find out if an IMAP message is marked for deletion. Here is the code if anyone is interested. There may be better ways to do some of this stuff, but I am new to outlook vba and this works.

'Macro loops through all mail items in current folder and if marked for deletion
'moves them to a folder called 'Deleted Items' then purges the current folder
'this allows a an IMAP account in outlook have the appearance of a Deleted Items folder.
'there is not much error checking, etc, but you get the jist.

Sub go()
Const pscImapDeleted As String = "{00062008-0000-0000-C000-000000000046}"
Const piDelId As Integer = &H8570
Const plDelTag As Long = 0
Dim mInBoxItems As Outlook.Items
Dim pobjSafeMailItem As Object
Dim pvDelId As Variant
Dim pvDeletedTag As Variant
Dim utils As Object
Dim iMailLoop As Integer
Set myOlApp = CreateObject("Outlook.Application")
Dim myExplorer As Explorer
Set myExplorer = myOlApp.ActiveExplorer
Set myNameSpace = myOlApp.GetNamespace("MAPI")

'test for mail folder
folderType = myExplorer.CurrentFolder.DefaultItemType

'is it a mail folder?
If TypeName(myExplorer) = "Nothing" Or folderType <> 0 Then
GoTo badMailbox
End If

'get the current folder
Set thisfolder = myExplorer.CurrentFolder
Set mInBoxItems = thisfolder.Items
Set pobjSafeMailItem = CreateObject("Redemption.SafeMailItem")

For iMailLoop = 1 To mInBoxItems.Count
Set mobjolmailobject = mInBoxItems.Item(iMailLoop)
Set utils = CreateObject("Redemption.MAPIUtils")

pobjSafeMailItem.Item = mobjolmailobject
pvDelId = pobjSafeMailItem.GetIDsFromNames(pscImapDeleted, piDelId)
pvDelId = pvDelId Or &H3
pvDeletedTag = pobjSafeMailItem.Fields(pvDelId)

If pvDeletedTag Then
Set myItem = mInBoxItems.Item(iMailLoop)
Set TrashFolder = thisfolder.Folders("Deleted Items")
myItem.Move (TrashFolder)
End If
Next

'purge deleted items from folder.
Dim myBar As CommandBar
Set myBar = Application.ActiveExplorer.CommandBars("Menu Bar")
Dim myButtonPopup As CommandBarPopup
Set myButtonPopup = myBar.Controls("Edit")
Dim myButton As CommandBarButton
Set myButton = myButtonPopup.Controls("Purge Deleted Messages")
myButton.Execute

Exit Sub

badMailbox:
MsgBox ("This macro is designed to only work on mail folders.")
Exit Sub

End Sub

[Hornblower40]

There is a way to get the "Marked For Deletion" (aka "IMAP Status") flag without Redemption using an Outlook Property Accessor. The Property Id is ""http{colon}//" & "schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/85700003". It returns a Long/Boolean 0 = Not Marked, 1 = Marked.