Vba ItemAdd中的Copy方法生成运行时错误

当我运行此代码时，会出现以下错误：

运行时错误“-2147221233（8004010f）”： 尝试的操作失败。找不到对象

尽管有错误，但一切正常。 如果我更改行，错误就会消失

“MsgBox”太棒了

到

MsgBox“棒极了”

一些测试表明，如果将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

---

复制项目会将项目添加到“已发送项目”文件夹，从而触发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

---

复制项目会将项目添加到“已发送项目”文件夹，从而触发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

---

由于它们是MsgBox之后的唯一行，我建议代码无法跟踪其中一个被设置为Nothing的对象。众所周知，使用MsgBox减慢处理速度，或使用F8单步执行代码，有时不会再现错误。这可能会导致其他问题，但作为一种解决方法，请尝试一次删除一条Set=Nothing语句，直到没有错误为止，只保留不会导致问题的语句。删除Set=Nothing不起作用。删除副本是可行的，但这并不是我真正想要的。请参阅edit因为它们是MsgBox之后的唯一行，所以我建议代码无法跟踪其中一个被设置为Nothing的对象。众所周知，使用MsgBox减慢处理速度，或使用F8单步执行代码，有时不会再现错误。这可能会导致其他问题，但作为一种解决方法，请尝试一次删除一条Set=Nothing语句，直到没有错误为止，只保留不会导致问题的语句。删除Set=Nothing不起作用。删除副本是可行的，但这并不是我真正想要的。参见编辑