Macro to identify deleted items w/IMAP and Outlook

[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