CODEWITHSUNDEEP
vbaemailoutlook
Andhi
Andhi

Reputation: 21

Copy method in ItemAdd throws error -2147221241 (80040107)

I'm trying to copy mail items on arrival in Inbox to other folder.

It throws error -2147221241 (80040107) but the mail is successfully copied somehow, only the script is stopped.

On debugging this line is highlighted:

Set myCopiedItem = Item.Copy

Here's my code.

Public WithEvents objMails As Outlook.Items

Private Sub Application_Startup()
    Set objMails = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub objMails_ItemAdd(ByVal Item As Object)

    Dim msg As Outlook.MailItem
    Dim myCopiedItem As Outlook.MailItem
    Dim myNameSpace As Outlook.NameSpace
    Dim myFolder As Outlook.Folder
    Dim myNewFolder As Outlook.Folder

    If Item.Class = olMail Then
       Set msg = Item
       Set myCopiedItem = Item.Copy
       Set myNameSpace = Application.GetNamespace("MAPI")
       Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
       Set myNewFolder = myFolder.Folders("_tmp_copy_mail")
       myCopiedItem.Move myNewFolder
    End If

End Sub

Upvotes: 1

Views: 261

Answers (1)

Andhi
Andhi

Reputation: 21

well after sleepless night, i manage to find the solution. Apparently this code

Set myCopiedItem = Item.Copy

make a duplicate of the incoming mail AND triggers the ItemAdd event and will create endless loop of the email duplication. hence the errors.

workaround is to temporarily stop the monitoring of ItemAdd process, do the copy and move, and start again the monitoring.

so the modified working code below:

If Item.Class = olMail Then

   'disable itemAdd monitoring
   Set objMails = Nothing

   'do the work
   Set myCopiedItem = Item.copy
   Set myNameSpace = Application.GetNamespace("MAPI")
   Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
   Set myNewFolder = myFolder.Folders("_tmp_copy_mail")
   myCopiedItem.Move myNewFolder

   'enable again the monitoring
   Set objMails = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
End If

Upvotes: 1

Related Questions