如何使“setAlwaysMoveConversation”正常工作？答案

【问题标题】：How do I make a "setAlwaysMoveConversation" that works properly?如何使“setAlwaysMoveConversation”正常工作？
【发布时间】：2020-06-23 08:45:26
【问题描述】：

在 Outlook 中，如果我激活“始终在此对话中移动邮件”，它将：

将对话中的所有邮件移动到目标文件夹，包括已发送邮件中的邮件
从那一刻起，该对话中收到的所有消息都将移至目标文件夹。但是，该对话中发送的所有消息都将保留在已发送邮件文件夹中。

我希望第 1 步排除已发送项目中的那些。

背景：我们正在使用一个共享邮箱，我无法为我们每个人都提供一个快速步骤，因为它们太多了。所以我制作了一个带有用户名的按钮，并移动（启用始终移动）到相应的文件夹。

但是，我希望保留已发送的项目 - 这可能吗，还是我应该制作自己的“alwaysMoveMessages”功能？

谢谢！

【问题讨论】：

stackoverflow.com/a/36467744/4539709
@Om3r，谢谢！这就是我需要的。我将添加排除已发送邮件文件夹的条件。
在这里发布作为答案，我会接受它

标签： vba outlook

【解决方案1】：

使用 Conversation.GetRootItems 一个 SimpleItems 集合，其中包括对话的根项目或所有根项目，以及 Conversation.GetTable 一个包含对话中所有项目的 Table 对象。

示例代码

Option Explicit
Sub MoveConv()
    Dim olNs As NameSpace
    Dim Inbox As Outlook.MAPIFolder
    Dim SubFolder As Outlook.MAPIFolder
    Dim SelectedItem As Object
    Dim Item As Outlook.MailItem ' Mail Item
    Dim Folder As Outlook.MAPIFolder ' Current Item's Folder
    Dim Conversation As Outlook.Conversation ' Get the conversation
    Dim ItemsTable As Outlook.Table ' Conversation table object
    Dim MailItem As Object

    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)

'    On Error GoTo MsgErr
'   // Must Selected Item.
    Set SelectedItem = Application.ActiveExplorer.Selection.Item(1)

'   // If Item = a MailItem.
    If TypeOf SelectedItem Is Outlook.MailItem Then
        Set Item = SelectedItem
        Set Conversation = Item.GetConversation

        If Not IsNull(Conversation) Then
            Set ItemsTable = Conversation.GetTable

            For Each MailItem In Conversation.GetRootItems ' Items in the conv.
                If TypeOf MailItem Is Outlook.MailItem Then
                    Set Item = MailItem
                    Set Folder = Item.Parent
                    Set SubFolder = Inbox.Folders("Temp") ' Move to Temp Folder
                    Debug.Print Item.ConversationID & " In Folder " & Folder.Name
                    GetConv Item, Conversation
                    Item.Move SubFolder
                End If
            Next
        End If
    End If

MsgErr_Exit:
    Set olNs = Nothing
    Set Inbox = Nothing
    Set Item = Nothing
    Set SelectedItem = Nothing
    Set MailItem = Nothing
    Exit Sub

'// Error information
MsgErr:
    MsgBox "Err." _
         & vbCrLf & "Error Number: " & Err.Number _
         & vbCrLf & "Error Description: " & Err.Description _
         , vbCritical, "Error!"
    Resume MsgErr_Exit
End Sub

Function GetConv(Item As Object, Conversation As Outlook.Conversation)
    Dim Items As Outlook.SimpleItems
    Dim MailItem As Object
    Dim Folder As Outlook.Folder
    Dim olNs As NameSpace
    Dim Inbox As Outlook.MAPIFolder
    Dim SubFolder As Outlook.MAPIFolder

    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    Set Items = Conversation.GetChildren(Item)

    If Items.Count > 0 Then
        For Each MailItem In Items
            If TypeOf MailItem Is Outlook.MailItem Then
                Set Item = MailItem
                Set Folder = Item.Parent
                Set SubFolder = Inbox.Folders("Temp")
                Debug.Print Item.ConversationID & " In Folder " & Folder.Name
                Item.Move SubFolder
            End If
            GetConv Item, Conversation
        Next
    End If
End Function

【讨论】：