मैंने अन्य उत्तर पोस्ट के संयोजन का उपयोग किया , और इस लेख ने मेरी खुद की मैक्रो लिखने के लिए जो मोचन लाइब्रेरी का उपयोग वार्तालापों को मर्ज करने के लिए करता है।
यह वर्तमान फ़ोल्डर को स्कैन करता है, किसी भी जीरा ईमेल को बाहर निकालता है, विषय से मुद्दे की कुंजी निकालता है। यदि यह उस कुंजी को पहले नहीं देखा गया है, तो यह समस्या कुंजी के आधार पर एक संग्रह में वार्तालाप सूचकांक को बचाता है, और यदि इसे पहले देखा है, तो यह सहेजे गए वार्तालाप सूचकांक के साथ ईमेल को अपडेट करता है।
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
इसके लिए निम्न पुस्तकालयों की आवश्यकता है:
- पूर्ण आरडीओ पहुंच के लिए मोचन पुस्तकालय , वार्तालाप सूचकांक सेट करने के लिए आवश्यक है (इसे पंजीकृत करने के लिए उन्नयन की आवश्यकता नहीं है)
Microsoft VBScript Regular Expressions 5.5
मेल विषयों से मुद्दे की चाबियाँ निकालने के लिए पुस्तकालय का संदर्भ ।
ओह, और आपको इसे चलाने के लिए अपनी मैक्रो सुरक्षा सेटिंग्स को भी नियंत्रित करना होगा।