Как автоматически помечать непрочитанные письма, старше определённого количества дней, как прочитанные в Outlook?

Если в папке «Входящие» есть несколько непрочитанных писем, вы, как правило, можете воспользоваться функцией «Пометить всё как прочитанное», чтобы вручную отметить их как прочитанные. Но пробовали ли вы автоматически помечать как прочитанные только те непрочитанные письма, которые старше заданного количества дней, — без необходимости каждый раз настраивать это вручную?

Автоматическая пометка непрочитанных писем старше определённого количества дней как прочитанных с помощью кода VBA

---

Автоматическая пометка непрочитанных писем старше определённого количества дней как прочитанных с помощью кода VBA

Чтобы автоматически помечать все непрочитанные письма старше определённого количества дней как прочитанные, приведённый ниже код VBA окажет вам помощь:

1. Удерживая клавиши ALT + F11, откройте окно Microsoft Visual Basic для приложений.

2. В окне Microsoft Visual Basic для приложений дважды щёлкните элемент ThisOutlookSession на панели Project1 (VbaProject.OTM), чтобы открыть модуль, а затем скопируйте и вставьте приведённый ниже код в пустой модуль.

Код VBA: Автоматическая пометка непрочитанных писем старше определённого количества дней как прочитанных:

Private Sub Application_Startup()
        Call MarkOldUnreadEmailsAsRead
    End Sub
    Private Sub MarkOldUnreadEmailsAsRead()
    Dim xInboxFld As Outlook.Folder
    Dim xAccount As Account
    On Error GoTo L1
    For Each xAccount In Outlook.Application.Session.Accounts
        Set xInboxFld = xAccount.DeliveryStore.GetDefaultFolder(olFolderInbox)
        Call Processfolders(xInboxFld)
    Next xAccount
L1:     Exit Sub
    End Sub
    Private Sub Processfolders(ByVal InboxFld As Outlook.Folder)
    Dim xItems As Outlook.Items
    Dim i As Long
    Dim xSubFld As Outlook.Folder
    On Error Resume Next
    Set xItems = InboxFld.Items
    For i = 1 To xItems.Count
        If DateDiff("d", xItems(i).ReceivedTime, Now) >= 15 Then
           If xItems(i).UnRead = True Then
              xItems(i).UnRead = False
              xItems(i).Save
           End If
        End If
    Next
    If InboxFld.Folders.Count > 0 Then
       For Each xSubFld In InboxFld.Folders
           Call Processfolders(xSubFld)
       Next
    End If
End Sub

Примечание: В приведённом выше коде вы можете изменить количество дней в следующей строке:If DateDiff(«d», xItems(i).ReceivedTime, Now) >= 15Then на нужное вам значение.

3. Затем сохраните и закройте это окно с кодом. Начиная с этого момента, при каждом запуске Outlook все непрочитанные письма, возраст которых превышает заданное количество дней, будут автоматически отмечаться как прочитанные за один раз.

Примечание: Этот код работает только с учётной записью данных по умолчанию.