How to move all messages in a conversation?

问题

I need to know how to move all of the messages in a conversation at once.

My macro currently reads

Sub Archive()
    Set ArchiveFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders("Archive")
    For Each Msg In ActiveExplorer.Selection
        Msg.UnRead = False
        Msg.Move ArchiveFolder
    Next Msg
End Sub

But that only moves the latest message... and only when the conversation is fully collapsed! I can't Archive when the conversation is expanded.

回答1:

If you want to handle conversations, you'll have to do so explicitly. You can go from MailItem to its Conversation using MailItem.GetConversation, but you'd be better off working with conversations directly.

What you do is:

Get all conversation headers from the current selection
For each conversation, get the individual items
Do your archiving thing with them.

The following C# code illustrates this, and should be trivial to port to VBA.

Outlook.Selection selection = Application.ActiveExplorer().Selection;
Outlook.Selection convHeaders = selection.GetSelection( Outlook.OlSelectionContents.olConversationHeaders) as Outlook.Selection;
foreach (Outlook.ConversationHeader convHeader in convHeaders)
{
  Outlook.SimpleItems items = convHeader.GetItems();
  for (int i = 1; i <= items.Count; i++)
  {
    if (items[i] is Outlook.MailItem)
    {
      Outlook.MailItem mail =  items[i] as Outlook.MailItem;
      mail.UnRead = false;
      mail.Move( archiveFolder );
    }
    // else... not sure how if you want to handle different types of items as well  }
}

回答2:

Paul-Jan put me on the right path, so I gave him the answer. Here's my really poor VBA version (I'm missing some type casting, checking). But it does work on collapsed and expanded conversations of mail.

Sub ArchiveConversation()
    Set ArchiveFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders("Archive")
    Set Conversations = ActiveExplorer.Selection.GetSelection(Outlook.OlSelectionContents.olConversationHeaders)
    For Each Header In Conversations
        Set Items = Header.GetItems()
        For i = 1 To Items.Count
            Items(i).UnRead = False
            Items(i).Move ArchiveFolder
        Next i
    Next Header
End Sub

回答3:

Anthony's answer almost works for me. But it doesn't work on both messages and conversations. Here's my modification:

Sub Archive()
    Set ArchiveFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders("Archive")

    Dim IsMessage As Integer
    IsMessage = 0

    For Each Msg In ActiveExplorer.Selection
        Msg.Move ArchiveFolder
        IsMessage = 1
    Next Msg

    If IsMessage = 0 Then
        Set Conversations = ActiveExplorer.Selection.GetSelection(Outlook.OlSelectionContents.olConversationHeaders)
        For Each Header In Conversations
            Set Items = Header.GetItems()
            For i = 1 To Items.Count
                Items(i).UnRead = False
                Items(i).Move ArchiveFolder
            Next i
        Next Header
    End If

End Sub

来源：https://stackoverflow.com/questions/6219460/how-to-move-all-messages-in-a-conversation

标签

vba

outlook

outlook-vba