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 

다음

은 기존의 매크로입니다