Outlook 2010,将电子邮件复制到文件夹中并将复制的电子邮件标记为已读,但将原始电子邮件保留为未读

时间:2014-05-09 19:54:51

标签: outlook-2010

我设置的规则是将包含特定关键字的电子邮件复制到特定文件夹并标记为已读。

我遇到的问题是,当它将这些电子邮件复制到文件夹时,它会将收件箱中的原始电子邮件标记为已读,这可能会导致我错过该邮件。 如果我没有将其标记为已读,那么当我在收件箱中读取它时,它在特定文件夹中保持未读状态。

我无法找到任何规则属性来完成此任务,任何人都有任何想法?

1 个答案:

答案 0 :(得分:0)

将规则设置为复制到目标文件夹,但不将其标记为已读。

将此未经测试的代码放在ThisOutlookSession模块中。假设目标文件夹直接位于收件箱下。如果深埋,请根据需要添加.Folders。

Option Explicit

' one line for each target folder
Private WithEvents myOlItemsA  As Outlook.Items
Private WithEvents myOlItemsB  As Outlook.Items

Private Sub Application_Startup()

    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")

    ' one line for each target folder
    Set myOlItemsA = objNS.GetDefaultFolder(olFolderInbox).Folders("targetfoldernameA").Items
    Set myOlItemsB = objNS.GetDefaultFolder(olFolderInbox).Folders("targetfoldernameB").Items

End Sub

' one copy of ItemAdd code for each target folder
Private Sub myOlItemsA_ItemAdd(ByVal item As Object)

    On Error GoTo ErrorHandler
    Dim Msg As Outlook.MailItem

    If TypeName(item) = "MailItem" Then
        Set Msg = item
        Msg.Unread = False
    End If

ProgramExit:
    Set Msg = Nothing
    Exit Sub

ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit

End Sub

Private Sub myOlItemsB_ItemAdd(ByVal item As Object)
 ' same code as for myOlItemsA
End Sub

基于此帖Using VBA to read new Outlook Email?

的代码

规则将邮件移动到目标文件夹。 ItemAdd代码作用于添加到目标文件夹的项目。