如何在MS Outlook中使用VBA中的"Always Move Messages in This Conversation"功能？

Question

我正在尝试在MS Outlook中实现搜索和移动功能。搜索是可以的，它就像魅力一样。但是，我只能找到"移动"功能将邮件移动到Outlook文件夹中。

我手动使用"始终在此对话中移动邮件"功能。现在，我想从宏中使用它。有什么方法可以从VBA中使用此功能吗？

这是当前的实现，但它使用了简单的移动功能：

Private Sub btn_Click()
    Dim currentMail As Object
    Dim F As Outlook.MAPIFolder
    Dim Msg$
    Set currentMail = Application.ActiveWindow
    If TypeOf currentMail Is Outlook.Inspector Then
      Set currentMail = obj.CurrentItem
    Else
      Set currentMail = obj.Selection(1)
    End If
    currentMail.Move Folder
End Sub

Answer 1

这就是您想要的

Dim currentMail As MailItem
Dim conv As Conversation
Dim myFolder As Folder 'you have to set it to your target folder
Set conv = currentMail.GetConversation
conv.SetAlwaysMoveToFolder myFolder, myFolder.Store

Answer 2

不确定这是否是您的要求，但以下是如何将某些对话中的outlook消息移动到子文件夹。

更新SubFolder = Inbox.Folders("Temp")临时文件夹

代码将在您的outlook中搜索同一对话中的所有消息，然后将其移动到临时文件夹

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 conversation.
                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