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

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

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

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

Получив новое письмо в том же разговоре, переместите старое письмо в подпапку.

Я нашел базу для перемещения писем старше 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 голосов
/ 18 июля 2019

Перебор всех элементов в папке не очень хорошая идея: 

 For intCount = objSourceFolder.Items.Count To 1 Step -1
        Set objVariant = objSourceFolder.Items.Item(intCount)

Вместо этого используйте методы Find / FindNext или Restrict класса Items. Подробнее об этих методах читайте в следующих статьях:

...