Question

当我运行此代码时，我收到错误：

运行时错误'-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

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

ItemAdd中的复制方法生成运行时错误

1 个答案: