How to use "Always Move Messages in This Conversation" feature from VBA in MS Outlook? - vba

Question

I'm trying to implement a search and move feature in MS Outlook. Search is OK, it works like charm. But, I can find only the Move function to move message into an Outlook folder.
I use the Always Move Messages in This Conversation feature manually. Now, I'd like to use it from macro. Is there any way to use this feature from VBA?
Here is the current implementation but it uses the simple Move feature:
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

This is what you want
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

Not sure if this is what your asking but here is how to move outlook messages in some conversations to sub-folder.
Update SubFolder = Inbox.Folders("Temp") Temp folder
Code will search all messages in same conversation in your outlook and then move it to Temp folder
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