Using VBA to Change IMAP Delete functionality

E

EastAsia

I am attempting to change how Outlook manages the IMAP Delete command.
(Sorry this was posted in the VBA newsgroup but there seems to be almost no
activity in that group!)

I want to press delete, and have outlook move the item to the Trash folder,
then mark the item for deletion and purge the item from the current folder
view.

I have the following script (Compliments LaFang) to help me do what I want,
but it has a few
problems.

1. It only runs when I select the macro from the Macros menu. I would like
this to be a constantly running rule.
2. It moves the item to the Trash folder, but appears as an unread item in
the trash folder.
3. It appears to work wether you are looking at a IMAP account or a POP
account, I would like to have it just work in my IMAP accounts.
4. When I press delete, it asks me if I want to purge all the items, I want
it to purge the items automagically, without having to press another button.
5. If I am in the Trash folder, the item should be deleted as normally - I
get an error that the item cannot be moved.


Could anyone help me with this?
Thanks!
/CL


Sub DeleteMessages()

Set myOlApp = CreateObject("Outlook.Application")

Dim myNameSpace As NameSpace

Set myNameSpace = myOlApp.GetNamespace("MAPI")

Dim myExplorer As Explorer

Set myExplorer = myOlApp.ActiveExplorer

'Get the folder type, expected type is 0 i.e. mail folder. If other type of
folder
'being used then abort macro as it should only be used with mail folders.
folderType = myExplorer.CurrentFolder.DefaultItemType

'Check that folder is mail folder
If TypeName(myExplorer) = "Nothing" Or folderType <> 0 Then
GoTo invalidMailbox
End If

'Locate root folder for this account
Set thisFolder = myExplorer.CurrentFolder
Do Until thisFolder.Parent = myNameSpace
Set thisFolder = thisFolder.Parent
Loop
Set accountFolder = thisFolder

'Identify selected messages
Dim selectedItems As Selection
Set selectedItems = myExplorer.Selection
Dim currentMailItem As MailItem
Dim iterator As Long

'Run loop on selected messages
For iterator = 1 To selectedItems.Count
Set currentMailItem = selectedItems.Item(iterator)

'Move messages to Deleted Items folder
Set trashFolder = accountFolder.Folders("Trash")
currentMailItem.Move (trashFolder)

Next

'Now, purge deleted messages
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

invalidMailbox:
MsgBox ("Macro configured only to work with mail folders! ")

Exit Sub

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top