Удалить элементы, используя значения поля ввода - PullRequest
1 голос
/ 10 июня 2019

Я пытаюсь написать макрос, который запрашивает у конечного пользователя число, а затем очищает папку «Удаленные» от всего, что старше указанного количества дней.

Код ниже работает, если я изменю папку на Входящие или Отправленные.

Я попробовал oItems.Item (i) .ReceivedTime и получил то же сообщение об ошибке.

Sub ClearDeletedItems()
 Dim oDeletedItems As Outlook.Folder
 Dim oFolders As Outlook.Folders
 Dim oItems As Outlook.Items
 Dim i As Long
 Set oDeletedItems = 
Application.Session.GetDefaultFolder(olFolderDeletedItems)
 Set oItems = oDeletedItems.Items
 days = CInt(InputBox("How many days of Deleted Items do you want to 
 keep?"))

For i = oItems.Count To 1 Step -1
    If DateDiff("d", oItems.Item(i).SentOn, Now) > days Then
    oItems.Item(i).Delete
 End If
 Next
End Sub

Получаю ошибку 438 - объект не поддерживает это свойство или метод.

1 Ответ

0 голосов
/ 11 июня 2019

Как насчет следующего ....

Option Explicit
Public Sub Example()
    Dim DeletedFolder As Outlook.MAPIFolder
    Set DeletedFolder = Application.GetNamespace("MAPI" _
                                  ).GetDefaultFolder(olFolderDeletedItems)

    Dim NumDays As String
        NumDays = InputBox(prompt:="Enter the number of days", _
              Title:="Enter the number of days", Default:="Enter number here")
              Debug.Print NumDays 'Immediate Window
        If Trim(NumDays) = vbNullString Then Exit Sub


    If Not IsNumeric(NumDays) Then
        MsgBox "You must enter a numerical value."
        Exit Sub
    End If

    Dim lngDateDiff As Long
        lngDateDiff =  Now -  NumDays
    Dim Filter As String
        Filter = "[SentOn]  < '" & Month(lngDateDiff) & _
                               "/" & Day(lngDateDiff) & _
                               "/" & Year(lngDateDiff) & "'"

    Dim Items As Outlook.Items
    Set Items = DeletedFolder.Items.Restrict(Filter)

    Debug.Print Items.Count  'Immediate Window

'   // Loop through backwards
    Dim i As Long
    For i = Items.Count To 1 Step -1
        DoEvents
        Debug.Print Items(i) 'Immediate Window
'       Items.Remove i ' un-comment to delete items
    Next

    Set DeletedFolder = Nothing
    Set Items = Nothing
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...