Question

在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

有人知道如何处理正确的循环吗？

Answer 1

对于每个循环来说，很棒，但是当移动/删除项目时，以相反的顺序循环通过，您知道倒数（即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

将特定的邮件从一个文件夹移动到另一个文件夹

1 个答案: