Метод копирования в ItemAdd генерирует ошибку времени выполнения

Question

Когда я запускаю этот код, я получаю сообщение об ошибке:

Ошибка времени выполнения '-2147221233 (8004010f)': Попытка операции не удалась. Не удалось найти объект.

Все работает, несмотря на ошибку. Ошибка исчезнет, ​​если я поменяю строку

'MsgBox "Awesome"

до

MsgBox "Awesome"

Несколько тестов показали, что ошибка возникает, если item.Sendername используется с копируемой частью. Если я просто перевожу почту, она отлично работает. Если я пытаюсь использовать код отдельно, он работает без ошибок.

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

Нет ошибки, если она не скопирована. Все в порядке со следующим кодом

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

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

Answer 1

Копирование элемента добавляет элемент в папку «Отправленные», вызывая код ItemAdd.

Временно отключите событие ItemAdd.

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