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 项目的数字证书”工具创建新证书。