我如何制作“setAlwaysMoveConversation"?工作正常吗? [英] How do I make a "setAlwaysMoveConversation" that works properly?
问题描述
在 Outlook 中,如果我激活始终在此对话中移动邮件",它将:
In Outlook, if I activate "always move messages in this conversation", it will:
- 将对话中的所有邮件移动到目标文件夹,包括已发送邮件
- 从那一刻起,该对话中收到的所有消息都将移动到目标文件夹.但是,该对话中发送的所有邮件都将保留在已发送邮件文件夹中.
- Move all of the messages in the conversation to the target folder, including those in Sent Items
- From that moment on, all messages received in that conversation will be moved to the target folder. However, all messages sent in that conversation will remain in the Sent Items folder.
我希望第 1 步排除已发送邮件中的那些.
I want step 1 to exclude those already in sent items.
背景:我们正在使用共享邮箱,我无法为我们每个人快速完成一个步骤,因为它们太多了.所以我做了一个带有按钮的子按钮,该按钮接受用户名并移动(启用始终移动)到相应的文件夹.
Background: we're using a shared mailbox, and I can't have a quick step for each of us because there will be too many of them. So I made a sub with a button that takes the username and moves (enables always move) to the corresponding folder.
但是,我希望保留已发送的项目 - 这是可能的,还是应该创建自己的alwaysMoveMessages"功能?
But, I want the sent items to remain - is this possible, or should I make my own "alwaysMoveMessages" function?
谢谢!
推荐答案
使用 Conversation.GetRootItems 一个 SimpleItems
集合,包括对话的根项目或所有根项目和 Conversation.GetTable 包含对话中所有项目的 Table 对象.
Work with Conversation.GetRootItems A SimpleItems
collection that includes the root item or all root items of the conversation and Conversation.GetTable A Table object that contains all Items in the conversation.
示例代码
Option Explicit
Sub MoveConv()
Dim olNs As NameSpace
Dim Inbox As Outlook.MAPIFolder
Dim SubFolder As Outlook.MAPIFolder
Dim SelectedItem As Object
Dim Item As Outlook.MailItem ' Mail Item
Dim Folder As Outlook.MAPIFolder ' Current Item's Folder
Dim Conversation As Outlook.Conversation ' Get the conversation
Dim ItemsTable As Outlook.Table ' Conversation table object
Dim MailItem As Object
Set olNs = Application.GetNamespace("MAPI")
Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
' On Error GoTo MsgErr
' // Must Selected Item.
Set SelectedItem = Application.ActiveExplorer.Selection.Item(1)
' // If Item = a MailItem.
If TypeOf SelectedItem Is Outlook.MailItem Then
Set Item = SelectedItem
Set Conversation = Item.GetConversation
If Not IsNull(Conversation) Then
Set ItemsTable = Conversation.GetTable
For Each MailItem In Conversation.GetRootItems ' Items in the conv.
If TypeOf MailItem Is Outlook.MailItem Then
Set Item = MailItem
Set Folder = Item.Parent
Set SubFolder = Inbox.Folders("Temp") ' Move to Temp Folder
Debug.Print Item.ConversationID & " In Folder " & Folder.Name
GetConv Item, Conversation
Item.Move SubFolder
End If
Next
End If
End If
MsgErr_Exit:
Set olNs = Nothing
Set Inbox = Nothing
Set Item = Nothing
Set SelectedItem = Nothing
Set MailItem = Nothing
Exit Sub
'// Error information
MsgErr:
MsgBox "Err." _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume MsgErr_Exit
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 Item = MailItem
Set Folder = Item.Parent
Set SubFolder = Inbox.Folders("Temp")
Debug.Print Item.ConversationID & " In Folder " & Folder.Name
Item.Move SubFolder
End If
GetConv Item, Conversation
Next
End If
End Function
这篇关于我如何制作“setAlwaysMoveConversation"?工作正常吗?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!