 Page [ 1 ]
|
|||
| Basic Outlook Printer Friendly Version | |||
|
Working with Outlook items, folders, recipients; dealing with security; writing event handlers | ||
| Topic | |||
|
Trapping the delete key in an IMAP account
I have a Gmail IMAP account. When I delete an item in Outlook, Outlook simply deletes it, but I want Outlook to move the item to the Bin folder within Gmail. I have written some code to trap the delete event, and to move the item to the Bin folder. Occasionally this works, but most of the time I get the following error on the line of code where the move takes place: Run-time error '-2147219840 (80040680)': The items were copied instead of moved because the original items cannot be deleted. The item cannot be deleted. It was either moved or already deleted, or access was denied. Strangely, if I end the session, the item gets moved as I want it to. I can't find any reference to this error message. Can anyone help please? Here is the code (courtesy of TeleKawaru): Public WithEvents myItem As MailItem 'for trapping deletion of opened mail 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 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) Dim lMI As MailItem Set lMI = item If MoveTo Is Nothing Then 'Item was deleted moveIMAPItem lMI Cancel = True 'bypass normal deletion function 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 Set TrashFolder = parentFolder.Folders("[Google Mail]").Folders("Bin") 'Set destination lMI.Move TrashFolder 'move email End Sub engeeaitch 07-Nov-2009 02:57 |
||
|
|
engeeaitch
11-Nov-2009 01:06
I am still trying to resolve this problem. Rather than trying to trap the delete event, I have used the following macro to delete the selected mail item. When I run the macro manually, I get the same error, i.e.:"The items were copied instead of moved because the original items cannot be deleted. The item cannot be deleted. It was moved or already deleted, or access was denied. I am beginning to think that this might be something to do with Google Mail, but I am still at a loss as to where to go next. Can anyone help please? (Macro code below, courtesy of this website) Sub test_delete() Dim myOlApp As Object Dim folderType As Integer Dim thisfolder As Folder Dim accountfolder As Folder 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 Dim trashfolder As Folder '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("[Google Mail]").Folders("Bin") currentMailItem.Move trashfolder Next Exit Sub invalidMailbox: MsgBox ("Macro configured only to work with mail folders! ") Exit Sub End Sub |
||
|
Page [ 1 ]
|
|||
| Post a new message to this topic. name email  |