Outlookの会話内のすべてのメールアイテムをVBAを使って読むように設定する

Question

私は会話全体をアーカイブするマクロを持っています。これは、会話のヘッダーを選択するだけでなく、会話内の単一のメールアイテムを選択する場合にも機能します。会話内のすべてのメッセージに既読としてマークする機能を追加したいと思います。私はそれを把握していないようだ。これどうやってするの？

Sub Archive() 
    Set ArchiveFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders("Archive") 
    If ArchiveFolder Is Nothing Then 
      Set ArchiveFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders.Add("Archive") 
    End If 
    Set oStore = ArchiveFolder.Store 
    Set selections = ActiveExplorer.Selection 
    If selections.Count <> 0 Then 
     ' Mail item selected 
     For Each theSelection In selections 
      Set oConv = theSelection.GetConversation 
      If Not (oConv Is Nothing) Then 
       oConv.SetAlwaysMoveToFolder ArchiveFolder, oStore 
       oConv.StopAlwaysMoveToFolder oStore 
      End If 
     Next theSelection 
    Else 
     ' Conversation header selected 
     Set oConv = ActiveExplorer.Selection.GetSelection(Outlook.OlSelectionContents.olConversationHeaders).Item(1).GetConversation 
     If Not (oConv Is Nothing) Then 
      oConv.SetAlwaysMoveToFolder ArchiveFolder, oStore 
      oConv.StopAlwaysMoveToFolder oStore 
     End If 
    End If 
End Sub 

Answer 1

これは私の仕事：：

Sub Archive() 
    Dim Item As Outlook.MailItem ' Mail Item 
    Dim oConv As Outlook.Conversation ' Get the conversation 

    Set ArchiveFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders("Archive") 
    If ArchiveFolder Is Nothing Then 
      Set ArchiveFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders.Add("Archive") 
    End If 
    Set oStore = ArchiveFolder.Store 
    Set selections = ActiveExplorer.Selection 

    If selections.Count <> 0 Then 
     ' Mail item selected 
     For Each theSelection In selections 
      Set oConv = theSelection.GetConversation 
      If Not (oConv Is Nothing) Then 

       For Each MailItem In oConv.GetRootItems ' Items in the conversation. 
        If TypeOf MailItem Is Outlook.MailItem Then 
         ' Set current mail item to read 
         Set Item = MailItem 
         Item.UnRead = False 

         ' Process all children as well 
         GetConv Item, oConv 
        End If 
       Next 

       oConv.SetAlwaysMoveToFolder ArchiveFolder, oStore 
       oConv.StopAlwaysMoveToFolder oStore 
      End If 
     Next theSelection 
    Else 
     ' Conversation header selected 
     Set oConv = ActiveExplorer.Selection.GetSelection(Outlook.OlSelectionContents.olConversationHeaders).Item(1).GetConversation 
     If Not (oConv Is Nothing) Then 

      For Each MailItem In oConv.GetRootItems ' Items in the conversation. 
       If TypeOf MailItem Is Outlook.MailItem Then 
        ' Set current mail item to read 
        Set Item = MailItem 
        Item.UnRead = False 

        ' Process all children as well 
        GetConv Item, oConv 
       End If 
      Next 

      oConv.SetAlwaysMoveToFolder ArchiveFolder, oStore 
      oConv.StopAlwaysMoveToFolder oStore 

     End If 
    End If 
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 current mail item to read 
       MailItem.UnRead = False 
      End If 
      ' Process all children as well 
      GetConv MailItem, Conversation 
     Next 
    End If 
End Function 

ここ

は、既存のマクロです