将Outlook对话中的所有邮件项设置为使用VBA进行阅读 [英] Set all mail items in an outlook conversation to read using VBA

问题描述

我有一个宏，用于存档整个对话.这既适用于在对话中选择单个邮件项目，也适用于选择对话标题.我想添加将会话中的所有消息标记为已读的功能.我似乎无法弄清楚.我该怎么办?

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?

这是现有的宏:

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

推荐答案

这对我有用:

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

这篇关于将Outlook对话中的所有邮件项设置为使用VBA进行阅读的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！