Utilicé una combinación de la otra publicación de respuestas y este artículo para escribir mi propia macro que usa la biblioteca Redemption para fusionar las conversaciones.
Esto escanea la carpeta actual, selecciona los correos electrónicos de jira, extrae la clave del problema del asunto. Si no se ha visto esa clave antes, guarda el índice de conversación en una colección basada en la clave de problema, y si la ha visto antes, actualiza el correo electrónico con el índice de conversación guardado.
Dim ConversationIndexes As New Collection
Sub GroupJira()
Dim MapiNamespace As Object
Dim RdoSession As Object
Dim Item As Object
Dim RdoItem As Object
Dim ConversationKey As String
Dim ConversationIndex As String
' Get all the required handles
Set MapiNamespace = Outlook.GetNamespace("MAPI")
MapiNamespace.Logon
Set RdoSession = CreateObject("Redemption.RDOSession")
RdoSession.MAPIOBJECT = MapiNamespace.MAPIOBJECT
'Setup some subject patterns to extract the issue key
Dim Matches As MatchCollection
Dim UpdateSubjectPattern As New RegExp
UpdateSubjectPattern.Pattern = "\[JIRA\] \(([A-Z]+-[0-9]+)\) .*"
Dim MentionedSubjectPattern As New RegExp
MentionedSubjectPattern.Pattern = "\[JIRA\] .* mentioned you on ([A-Z]+-[0-9]+) \(JIRA\)"
For Each Item In Outlook.ActiveExplorer.CurrentFolder.Items
If TypeOf Item Is MailItem Then
If Left(Item.Subject, 7) = "[JIRA] " Then
' Get a key for this conversation, opic for now
ConversationKey = Item.ConversationTopic
Set Matches = UpdateSubjectPattern.Execute(Item.Subject)
If Matches.Count >= 1 Then ConversationKey = Matches(0).SubMatches(0)
Set Matches = MentionedSubjectPattern.Execute(Item.Subject)
If Matches.Count >= 1 Then ConversationKey = Matches(0).SubMatches(0)
' Get any saved indexes
ConversationIndex = ""
On Error Resume Next
ConversationIndex = ConversationIndexes.Item(ConversationKey)
On Error GoTo 0
If ConversationIndex = "" Then
' Save this index if not seen yet
ConversationIndexes.Add Item.ConversationIndex, ConversationKey
ElseIf Item.ConversationIndex <> ConversationIndex Then
' Set the item's index if it has
Set RdoItem = RdoSession.GetMessageFromID(Item.EntryID, Item.Parent.StoreID)
RdoItem.ConversationIndex = ConversationIndex
RdoItem.Save
End If
End If
End If
Next Item
End Sub
Esto requiere las siguientes bibliotecas:
- Biblioteca de canje para acceso RDO completo, necesaria para establecer el índice de conversación (esto no requiere elevación para registrarlo)
- Una referencia a la
Microsoft VBScript Regular Expressions 5.5
biblioteca para extraer claves de problema de los asuntos del correo.
Ah, y también debes modificar la configuración de seguridad de tu macro para ejecutarla.