使用 VBA 将对话中的所有邮件项设置为阅读 [英] Set all mail items in a conversation to read using VBA
本文介绍了使用 VBA 将对话中的所有邮件项设置为阅读的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!
问题描述
我有将整个对话存档的代码.这适用于在对话中选择单个邮件项目以及选择对话标题.
I have code that archives entire conversations. This works for 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.
这是现有的代码:
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
这篇关于使用 VBA 将对话中的所有邮件项设置为阅读的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!
查看全文