Public WithEvents myItem As MailItem            'for trapping deletion of opened mail
Public WithEvents myInspector As Inspectors     'for trapping new windows
Public WithEvents myExplorer As Explorer        'for folder reference
Public WithEvents myFolder As Folder            'for trapping mail deletion in main outlook window
Public myNameSpace As NameSpace                 'Parent folder
Private Sub Application_Startup()
    Set myInspector = Application.Inspectors
    Set myExplorer = Application.ActiveExplorer
    Set myFolder = myExplorer.CurrentFolder
    Set myNameSpace = Application.GetNamespace("MAPI")
End Sub
Private Sub myExplorer_BeforeFolderSwitch(ByVal NewFolder As Object, Cancel As Boolean)
    Set myFolder = NewFolder
End Sub
Private Sub myFolder_BeforeItemMove(ByVal item As Object, ByVal MoveTo As MAPIFolder, Cancel As Boolean)
    If TypeName(item) = "MailItem" Then         'only trap mail items
        Dim lMI As MailItem
        Set lMI = item
        If MoveTo Is Nothing And lMI.Parent <> "Deleted Items" Then	'Item was deleted
            moveIMAPItem lMI
            Cancel = True                       'bypass normal deletion function
        End If
    End If
End Sub
Private Sub myInspector_NewInspector(ByVal Inspector As Inspector)
    If Inspector.CurrentItem.Class = olMail Then Set myItem = Inspector.CurrentItem 'New window for reading mail
End Sub
Private Sub myItem_BeforeDelete(ByVal item As Object, Cancel As Boolean)
    If TypeName(myItem) = "MailItem" Then       'only trap mail items
        moveIMAPItem item
        Cancel = True                           'bypass normal deletion
    End If
End Sub
Private Sub moveIMAPItem(ByVal item As Object)
    Dim lMI As MailItem
    Dim fParent As Folder
    Dim parentFolder As Folder
    Dim trashFolder As Folder
    Set lMI = item
    Set fParent = myExplorer.CurrentFolder
    Do Until fParent.Parent = myNameSpace       'Root folder
        Set fParent = fParent.Parent
    Loop
    Set parentFolder = fParent
    If parentFolder.Folders("Deleted Items") Is Nothing Then 'Deleted Items folder doesn't exist
        MsgBox "Unable to find folder named 'Deleted Items'", vbOKOnly + vbInformation, "IMAP Delete" 'Inform user and exit routine
        Exit Sub
    End If
    Set trashFolder = parentFolder.Folders("Deleted Items") 'Set destination
    lMI.Move trashFolder                            'move email
End Sub