Vba 如何移动对话中的所有消息？

我需要知道如何一次移动会话中的所有消息

我的宏当前读取

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

---

但这只是最新的信息。。。只有当对话完全崩溃时！对话展开时，我无法存档。

如果要处理对话，必须显式执行。您可以使用MailItem.GetConversation从MailItem转到其对话，但最好直接使用对话

你要做的是：

从当前选择中获取所有对话标题

对于每个对话，获取各个项目

用它们做你的归档工作

下面的C#代码说明了这一点，对于移植到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  }
}

Outlook.Selection=Application.ActiveExplorer（）.Selection；
Outlook.Selection convHeaders=Selection.GetSelection（Outlook.OlSelectionContents.olConversationHeaders）作为Outlook.Selection；
foreach（convHeaders中的Outlook.ConversationHeader convHeader）
{
Outlook.SimpleItems items=convHeader.GetItems（）；
因为（inti=1；i让我走上了正确的道路，所以我给了他答案。这是我非常糟糕的VBA版本（我缺少一些类型转换、检查）。但它确实适用于邮件的折叠和扩展对话

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

Anthony的回答对我几乎有效。但它不适用于消息和对话。以下是我的修改：

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

在Outlook 2003上是否有这样做的方法？