How to move all messages in a conversation?

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

My macro is currently reading

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 this only moves the last message ... and only when the conversation completely collapses! I cannot Archive when the conversation expands.

+2
source share
3 answers

If you want to handle conversations, you will need to do this explicitly. You can go from MailItem to his conversation using MailItem.GetConversation, but you better work with conversations directly.

What are you doing:

  • Get all conversation headers from current selection
  • For each conversation, get separate items
  • Do your archiving with them.

The following C # code illustrates this and should be trivial for the VBA port.

 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 } } 
+3
source

Paul-Jan set me on the right track, so I gave him the answer. Here is my really poor version of VBA (I miss some kind of casting, validation). But it works with collapsed and expanded conversations.

 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 
+8
source

Anthony's answer almost works for me. But this does not work for messages as well as for conversations. Here is 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 
+1
source

All Articles