I am trying to put a category on all the e-mails that have the same first 15 characters of the subject.
I have a script (which I borrowed here Macro in Outlook to delete duplicate emails-) that compares subject and body of e-mails, finds duplicates and moves them to the Deleted Items.
I would like to modify it to compare only the first 15 characters of subject and categorizes e-mails instead of deleting them.
Option Explicit
'Set a reference to the Microsoft Scripting Runtime from Tools, References.
Sub CategorizeDuplicateEmailsInSelectedFolder()
Dim i As Long
Dim n As Long
Dim Message As String
Dim Items As Object
Dim AppOL As Object
Dim NS As Object
Dim Folder As Object
Set Items = CreateObject("Scripting.Dictionary")
'Initialize and instance of Outlook
Set AppOL = CreateObject("Outlook.Application")
'Get the MAPI Name Space
Set NS = AppOL.GetNamespace("MAPI")
'Allow the user to select a folder in Outlook
Set Folder = NS.PickFolder
'Get the count of the number of emails in the folder
n = Folder.Items.Count
'Check each email starting from the last and working backwards to 1
'Loop backwards to ensure that the deleting of the emails does not interfere with subsequent items in the loop
For i = n To 1 Step -1
On Error Resume Next
'Load the matching criteria to a variable
'This is setup to use the Subject
Message = Folder.Items(i).Subject <- this part needs to be modifed
'Check a dictionary variable for a match
If Items.Exists(Message) = True Then
'If the item has previously been added then categorize this duplicate
Folder.Items(i).Categories = "Blue category" <- this part needs to be modifed
Else
'In the item has not been added then add it now so subsequent matches will be categorized
Items.Add Message, True
End If
Next i
ExitSub:
'Release the object variables from memory
Set Folder = Nothing
Set NS = Nothing
Set AppOL = Nothing
End Sub