Copy method in ItemAdd generates Runtime Error

问题

When I run this code I get the error:

Run-Time error '-2147221233 (8004010f)': The attempted operation failed. An object could not be found.

Everything is working despite the error. The error disappears if I change the line

'MsgBox "Awesome"

MsgBox "Awesome"

A few tests showed that the error does occur if item.Sendername is used with the copy part. If I do just move the mail it works perfectly. If I try to use the code separately it works without errors.

Private WithEvents snItems As Items

Private Sub Application_Startup()
    Set snItems = Session.GetDefaultFolder(olFolderSentMail).Items
End Sub

Private Sub snItems_ItemAdd(ByVal item As Object)
    Dim CopiedItem As MailItem
    Dim ShareInbox As Outlook.MAPIFolder
    Dim MapiNameSpace As Outlook.NameSpace

    If TypeName(item) = "MailItem" Then

        Set MapiNameSpace = Application.GetNamespace("MAPI")
        Set ShareInbox = MapiNameSpace.Folders("Support").Folders("Send Mails")

        If item.SenderName = "Support" Then
            Set CopiedItem = item.Copy
            CopiedItem.UnRead = True
            CopiedItem.Move ShareInbox
        End If
    End If

    'MsgBox "Awesome"

ExitRoutine:
    Set ShareInbox = Nothing
    Set CopiedItem = Nothing
    Set MapiNameSpace = Nothing
End Sub

There is no error if not copied. It is ok with the following Code

Set MapiNameSpace = Application.GetNamespace("MAPI")
Set ShareInbox = MapiNameSpace.Folders("Support").Folders("Gesendete Elemente")

If item.SenderName = "Support" Then
    item.Move ShareInbox
End If

回答1:

Copying the item adds an item to the Sent Items folder, triggering the ItemAdd code.

Disable the ItemAdd event temporarily.

Private Sub snItems_ItemAdd(ByVal item As Object)
    Dim CopiedItem As MailItem
    Dim ShareInbox As Outlook.MAPIFolder
    Dim MapiNameSpace As Outlook.NameSpace

    If TypeName(item) = "MailItem" Then

        Set MapiNameSpace = Application.GetNamespace("MAPI")
        Set ShareInbox = MapiNameSpace.Folders("Support").Folders("Send Mails")

        If item.SenderName = "Support" Then

            ' Turn off event handling
            Set snItems = Nothing

            Set CopiedItem = item.Copy
            CopiedItem.UnRead = True
            CopiedItem.Move ShareInbox

            ' Turn on event handling 
            Set snItems = Session.GetDefaultFolder(olFolderSentMail).Items

        End If
    End If

ExitRoutine:
    Set ShareInbox = Nothing
    Set CopiedItem = Nothing
    Set MapiNameSpace = Nothing
End Sub

来源：https://stackoverflow.com/questions/50168055/copy-method-in-itemadd-generates-runtime-error

标签

vba

outlook

outlook-vba