将对话中的旧电子邮件移至子文件夹

时间:2019-06-29 15:44:20

标签: outlook-vba

我正在寻找一个宏,以将会话中的较早电子邮件(按主题排序)移动到子文件夹,但该主题中的最新会话除外。

在同一对话中收到新邮件后,将旧电子邮件移至子文件夹。

我找到了移动7天以上的电子邮件的基地,但不确定如何移动较旧的对话并仅保留最新的邮件。

Sub MoveAgedMail()

    Dim objOutlook As Outlook.Application
    Dim objNamespace As Outlook.NameSpace
    Dim objSourceFolder As Outlook.MAPIFolder
    Dim objDestFolder As Outlook.MAPIFolder

    Dim objVariant As Variant
    Dim lngMovedItems As Long
    Dim intCount As Integer
    Dim intDateDiff As Integer
    Dim strDestFolder As String   

    Set objOutlook = Application
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    'Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
    Set objSourceFolder = objNamespace.Folders("Online Archive - OTCGROUP@abc.ssmb.com").Folders("Inbox").Folders("DEST1")

    ' use a subfolder under Inbox
    'Set objDestFolder = objSourceFolder.Folders("DEST")
     Set objDestFolder = objNamespace.Folders("Online Archive - OTCGROUP2@abc.ssmb.com").Folders("Inbox").Folders("DEST2")

    For intCount = objSourceFolder.Items.Count To 1 Step -1

        Set objVariant = objSourceFolder.Items.Item(intCount)
        DoEvents

        If objVariant.Class = olMail Then

             intDateDiff = DateDiff("d", objVariant.SentOn, Now)

            ' I'm using 7 days, adjust as needed.
            If intDateDiff > 7 Then
              objVariant.Move objDestFolder

              'count the # of items moved
               lngMovedItems = lngMovedItems + 1
            End If

        End If

    Next

    ' Display the number of items that were moved.
    MsgBox "Moved " & lngMovedItems & " messages(s)."

Set objDestFolder = Nothing

End Sub

1 个答案:

答案 0 :(得分:0)

遍历文件夹中的所有项目并不是一个好主意:

FindGameObjectsWithTag(string tag)

改用 For intCount = objSourceFolder.Items.Count To 1 Step -1 Set objVariant = objSourceFolder.Items.Item(intCount) 类的Find / FindNextRestrict方法。在以下文章中了解有关这些方法的更多信息: