ItemAdd中的复制方法生成运行时错误 [英] Copy method in ItemAdd generates Runtime Error

问题描述

运行此代码时出现错误:

When I run this code I get the error:

运行时错误'-2147221233(8004010f)': 尝试的操作失败.找不到对象.

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"

到

MsgBox很棒"

MsgBox "Awesome"

一些测试表明，如果将item.Sendername与复制部件一起使用，则会发生错误.如果我确实移动邮件，则效果很好. 如果我尝试单独使用该代码，它将正常工作.

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

推荐答案

复制项目会将项目添加到已发送项目"文件夹中，从而触发ItemAdd代码.

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

暂时禁用ItemAdd事件.

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

这篇关于ItemAdd中的复制方法生成运行时错误的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！