Outlook规则-移动已读且早于X天的邮件

Outlook2010。想要创建一个规则，将所有邮件从我的收件箱移动到另一个文件夹：

• 已阅读
• 比X天大

我当时在看自动存档，但是似乎并不能以此为标准。

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

搜索文件夹是答案，但是OP询问的邮件早于特定日期。如果您使用“上周修改”，那么它将显示上周内的所有内容，并过滤掉超过1周的内容。对于相反的情况，请使用如下语言：

• 8天前
• 1周前
• 等等...

我一直在寻找类似的东西。我必须使用宏，因为我的安装已禁用自动存档。这是我想出的：

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启动时运行。您可能还希望对其进行签名（并信任您的签名），以便获得安全性投诉。

高温超导