MS OutlookのVBAの「この会話で常にメッセージを移動する」機能の使用方法

Question

私はMS Outlookで検索と移動の機能を実装しようとしています。検索はOKです、それは魅力のように動作します。しかし、私は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

Tempフォルダに移動します

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

これはここにあなたの提示が、サブフォルダにいくつかの会話の中で見通しメッセージを移動する方法は何かあればわかりません。

更新SubFolder = Inbox.Folders("Temp") Tempフォルダ

コードがあなたの見通しに同じ会話内のすべてのメッセージを検索し、これはあなたが望むものである

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