Question

I have a macro that archives entire conversations. This works for both selecting a single mail item in the conversation as well as selecting the conversation header. I'd like to add the ability to mark all messages within the conversation as read. I can't seem to figure it out. How can I do this?

Here's the existing macro:

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

Set all mail items in an outlook conversation to read using VBA

1 个答案: