Переместить определенные письма из одной папки в другую - PullRequest
Новая
       11

Переместить определенные письма из одной папки в другую

0 голосов
/ 10 января 2019

в Outlook Я хотел бы иметь FollowUp-Solution, которое проверяет определенную папку (Исходную папку), если есть письма старше 1 дня, и перемещает их в другую определенную папку (Целевая папка).

Моя проблема в том, что мой код не выполняет цикл SourceFolder должным образом. Некоторые письма перемещаются, но некоторые старые письма все еще находятся в SourceFolder.

Когда я перезапускаю Код, некоторые из оставшихся писем теперь перемещаются, но некоторые остаются в SourceFolder.

Я пытался зациклить элементы другими способами (с; для каждого; делай), но я думаю, что мое понимание vba слишком плохое, чтобы получить работающее решение. 

Sub MoveFollowUpItems()
Dim FolderTarget    As Folder
Dim FolderSource    As Folder
Dim Item            As Object
Dim FolderItems     As Outlook.Items

Set FolderTarget = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set FolderSource = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("FollowUp")

Set FolderItems = FolderSource.Items

For Each Item In FolderItems
    If Item.ReceivedTime < Date - 1 Then    '
        Item.Move FolderTarget
        End If
    Next
End Sub

Кто-нибудь знает, как обращаться с циклом проппера?

1 Ответ

0 голосов
/ 10 января 2019

Для каждого цикла это здорово, но при перемещении / удалении элементов Loop Through в обратном порядке вы знаете обратный отсчет (т.е. 3,2,1). Для этого вы можете включить Step -1 в оператор цикла.

Также, чтобы улучшить ваш цикл, попробуйте использовать Items.Restrict Method (Outlook) в вашем фильтре даты

Пример 

Option Explicit
Sub MoveFollowUpItems()
    Dim FolderTarget    As Folder
    Dim FolderSource    As Folder
    Dim FolderItems     As Outlook.Items

    Set FolderTarget = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set FolderSource = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("FollowUp")

    Dim Filter As String
        Filter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:datereceived" & _
                          Chr(34) & " <= 'Date - 1' "

    Set FolderItems = FolderSource.Items.Restrict(Filter)

    Debug.Print FolderItems.Count

    Dim i As Long
    For i = FolderItems.Count To 1 Step -1
        Debug.Print FolderItems(i) 'Immediate Window
'        FolderItems(i).Move FolderTarget
    Next

End Sub
...