Outlook 规则 - 移动已读且超过 X 天的邮件

Outlook 规则 - 移动已读且超过 X 天的邮件

Outlook 2010。想要创建一条规则,将所有邮件从收件箱移动到另一个文件夹:

  • 已读
  • 已超过 X 天

我正在查看自动存档,但它似乎不允许我如此具体地确定我的标准。

答案1

目前我发现最好的方法是创建一个新的搜索文件夹,并设置自定义条件,例如在某个日期或之前修改的项目。然后我右键单击该文件夹并选择“全部删除”,这会将搜索文件夹中的所有项目发送到垃圾箱。

答案2

搜索文件夹是答案,但是 OP 询问的是邮件年长过特定日期。如果您使用“上周修改”,则它会显示上周的所有内容,并过滤掉超过 1 周的内容。相反,请使用以下语言:

  • 8天前
  • 1周前
  • ETC...

在此处输入图片描述

答案3

我一直在寻找类似的东西。我必须使用宏,因为我的安装禁用了自动存档。以下是我想到的:

Option Explicit
Private Sub Application_MAPILogonComplete()
    ' this runs on app startup
    Const MSG_AGE_IN_DAYS = 7

    Dim oFolder As Folder
    Dim oFilteredItems As Outlook.Items
    Dim oItem As MailItem
    Dim oDate As Date

    oDate = DateAdd("d", -MSG_AGE_IN_DAYS, Now())
    oDate = Format(oDate, "mm/dd/yyyy")

    ' you can use this command to select a folder
    'Set oFolder = Application.Session.PickFolder

    Set oFolder = Me.Session.Folders.GetFirst

    ' shows all the folder names
    'For Each fldr In oFolder.Folders
    '    Debug.Print fldr.Name
    'Next fldr

    ' this was the sub-folder I wanted to cleanup.
    Set oFolder = oFolder.Folders("Storage").Folders("batch runs")

    Debug.Print "checking " & oFolder.FolderPath
    Debug.Print "for msgs older than " & oDate

    ' you can modify the filter to suit your needs
    Set oFilteredItems = oFolder.Items.Restrict("[Received] <= '" & oDate & "' And [Unread] = True")

    Debug.Print "removing " & oFilteredItems.Count & " items"

    While oFilteredItems.Count > 0
        Set oItem = oFilteredItems.GetFirst
        Debug.Print "   " & oItem.UnRead & " " & oItem.Subject

        ' the remove method permanently deletes the item.
        oFilteredItems.Remove 1
        'Debug.Print oFilteredItems.Count & " items left"
    Wend

    Debug.Print ". end"

    Set oFolder = Nothing
    Set oFilteredItems = Nothing
    Set oItem = Nothing
End Sub

此宏附加到应用程序生命周期的最后阶段;它在 Outlook 启动时运行。您可能还想对其进行签名(并信任您的签名),这样您就不会收到安全投诉。

高血压

答案4

对于即将到来的研究人员,我使用开发人员工具完成了以下工作

    Public WithEvents olItems As Outlook.Items

    Sub Application_Startup()
        Set olItems = Session.GetDefaultFolder(olFolderInbox).Items
    End Sub

    Private Sub olItems_ItemChange(ByVal Item As Object)
        Dim deFolder As Folder
     
        'Ensure the email marked as read
        If TypeOf Item Is MailItem And Item.UnRead = False Then
     
        'Check the email subject and then move to specific folder
        'You can change these conditions and folders as per your needs
        If InStr(LCase(Item.Subject), "test") > 0 Then
           Set deFolder = Session.GetDefaultFolder(olFolderInbox).Parent.Folders("Test")
           Item.Move deFolder
        End If
     
        If InStr(LCase(Item.Subject), "worklog") > 0 Then
           Set deFolder = Session.GetDefaultFolder(olFolderInbox).Parent.Folders("WorkLog")
           Item.Move deFolder
        End If
     
        If InStr(LCase(Item.Subject), "report") > 0 Then
           Set deFolder = Session.GetDefaultFolder(olFolderInbox).Parent.Folders("Report")
           Item.Move deFolder
        End If
    End Sub

之后,您应该对此代码进行数字签名。使用内置的“VBA 项目的数字证书”工具创建新证书。

相关内容