如何修改conversationTopic,以便将具有不同主题的电子邮件放在同一个帖子中?

时间:2012-01-10 16:38:14

标签: vba outlook

我想帮助Outlook 2010线程化我的电子邮件。我的理解是它将会话视图基于conversationTopic的{​​{1}}属性。我编写了以下方法并创建了一个规则,因此它会触发电子邮件主题,如“订单#345 - 供应商回复”和“订单#345 - 客户回复”,并将它们放在同一个主题中。不幸的是MailItem是一个只读属性。

有没有人知道解决这个问题的方法,或者更好的方法来完成同样的任务?谢谢!

conversationTopic

4 个答案:

答案 0 :(得分:5)

正在寻找几乎完全相同的东西,正如你所指出的那样,正常暴露的对象似乎不可能,但VBA宏+ Outlook Redemption可以轻松调整对话主题。奖金,原始邮件主题没有变化,但邮件仍显示在一个漂亮的整洁对话组中。

像这样的东西,抛入VBA宏,然后在收到消息时使用您确定的任何条件将此脚本作为规则操作运行:

Sub MsgProcess(msg As MailItem)
    Dim oNS As Object
    Dim oRDOSess As Object
    Dim oRDOItem As Object
    Dim sEntryID As String
    Dim sStoreID As String

    Dim NewConversationTopic As String


    Set oRDOSess = CreateObject("Redemption.RDOSession")
    Set oNS = Nothing
    Set oNS = Outlook.GetNamespace("MAPI")
    oNS.Logon
    oRDOSess.MAPIOBJECT = oNS.MAPIOBJECT

    sEntryID = msg.EntryID
    sStoreID = msg.Parent.StoreID
    Set oRDOItem = oRDOSess.GetMessageFromID(sEntryID, sStoreID)

    'Apply what modifications to topic you want here - dumb example string manipulation shown
    NewConversationTopic = Replace(oRDOItem.ConversationTopic, "BLACK", "WHITE")

    oRDOItem.ConversationTopic = NewConversationTopic
    oRDOItem.Save
End Sub

答案 1 :(得分:1)

使用Outlook Redemption,我可以使用以下代码将选定的邮件项目合并到一个会话中。我根据我的需要将其模仿了@fredless的答案。

Public Sub MergeConversations()

Dim NewConversationTopic As String
Dim msg As MailItem
Dim msgSel As Selection
Dim oRDOSess, oNS, objRDOitem As Object

Set msgSel = Nothing
Set msgSel = Application.ActiveExplorer.Selection

If msgSel.Count <= 1 Then
   MsgBox ("Multiple Mail Items have not been selected!")
   Set msgSel = Nothing
   Exit Sub
End If

Set msg = msgSel.Item(1)

NewConversationTopic = msg.ConversationTopic

Set msg = Nothing

Set oRDOSess = CreateObject("Redemption.RDOSession")
Set oNS = Nothing
Set oNS = Outlook.GetNamespace("MAPI")
oNS.Logon
oRDOSess.MAPIOBJECT = oNS.MAPIOBJECT

For Each msg In msgSel
   Set objRDOitem = oRDOSess.GetMessageFromID(msg.EntryID, msg.Parent.StoreID)
   objRDOitem.ConversationTopic = NewConversationTopic

&#39;以下行来自此answer

   objRDOitem.Fields("http://schemas.microsoft.com/mapi/proptag/0x00710102") = Null
   objRDOitem.Save
   Set objRDOitem = Nothing
Next msg

Set msgSel = Nothing
Set msg = Nothing

End Sub

答案 2 :(得分:0)

您需要以正确的方式构建PR_CONVERSATION_INDEX属性 - 请参阅http://msdn.microsoft.com/en-us/library/office/cc765583.aspx。 可以使用MailItem.PropertyAccessor或Redemption中的RDOMail.Fields []设置该属性。

答案 3 :(得分:0)

这是@JoeFletch脚本的变体,其中进行了一些性能优化,以防止冻结外观,并提供可选的其他宏以在所有选定电子邮件上运行它,并在每一封新邮件到达时运行它。

Option Explicit

' This requires: http://www.dimastr.com/redemption/download.htm
Const ConversationIndexField As String = "http://schemas.microsoft.com/mapi/proptag/0x00710102"

Private oRDOSess As Redemption.RDOSession
Private WithEvents Items As Outlook.Items

Public Sub ClearSelectedConversationIds()
    Dim Message As Object
    For Each Message In Application.ActiveExplorer.Selection
        ClearConversationId Message
        DoEvents
        DoEvents
    Next Message
    Debug.Print "Finished Processing All Selected Messages"
End Sub

Private Sub Application_Startup()
    Dim olNS As Outlook.NameSpace
    Dim Inbox  As Outlook.MAPIFolder

    Set olNS = Application.GetNamespace("MAPI")
    Set Inbox = olNS.GetDefaultFolder(olFolderInbox)
    Set Items = Inbox.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
    If TypeOf Item Is Outlook.MailItem Then
        ClearConversationId Item
    End If
End Sub

主要子项:

Public Sub ClearConversationId(ByVal Item As Object)
    On Error GoTo Reset

    ' Initialize the Redemption instance if doesn't already exist
    If oRDOSess Is Nothing Then
        Debug.Print "Creating Redemption Object ..."
        Set oRDOSess = New Redemption.RDOSession
        With Outlook.GetNamespace("MAPI")
             .Logon
            oRDOSess.MAPIOBJECT = .MAPIOBJECT
        End With
    End If

    Dim oRDOItem As Object
    Set oRDOItem = oRDOSess.GetMessageFromID(Item.EntryID, Item.Parent.StoreID)

    If oRDOItem.ConversationTopic <> Item.Subject Or Not IsEmpty(oRDOItem.Fields(ConversationIndexField)) Then
        Debug.Print "Fixing " & Item.Subject
        oRDOItem.ConversationTopic = Item.Subject
        oRDOItem.Fields(ConversationIndexField) = Null
        oRDOItem.Save
    End If
    Exit Sub
Reset:
    Debug.Print "Error: " + Err.Description
    Set oRDOSess = Nothing
    End Sub