Reputation: 47
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
Upvotes: 0
Views: 533
Reputation: 9179
This turned out to be trickier than it first appeared.
Option Explicit
'Set a reference to the Microsoft Scripting Runtime from Tools, References.
Sub CategorizeDuplicateEmailsInSelectedFolder()
Dim i As Long
Dim n As Long
Dim startSubject As String
Dim dictItems As Object
Dim pFolder As Object
Dim pFolderItems As Items
Dim msgObj As mailItem
Set dictItems = CreateObject("Scripting.Dictionary")
'Allow the user to select a folder in Outlook
Set pFolder = Session.PickFolder
If pFolder Is Nothing Then Exit Sub
Set pFolderItems = pFolder.Items
'Get the count of the number of emails in the folder
n = pFolderItems.Count
pFolderItems.Sort "[ReceivedTime]", True
'Check each email starting from the oldest
For i = n To 1 Step -1
If TypeName(pFolderItems(i)) = "MailItem" Then
Set msgObj = pFolderItems(i)
'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
startSubject = Left(msgObj.subject, 15)
Debug.Print startSubject
'Check a dictionary variable for a match
If dictItems.Exists(startSubject) = True Then
'If the item has previously been added then categorize this duplicate
'pFolderItems(i).categories = "Blue category" ' <- This did not save
msgObj.categories = "Blue category" ' <- This could be saved
msgObj.Save
Else
'In the item has not been added then add it now so subsequent matches will be categorized
dictItems.Add startSubject, True
End If
End If
Next i
End Sub
https://excelmacromastery.com/vba-error-handling/#On_Error_Resume_Next
"There are specific occasions when this is useful. Most of the time you should avoid using it."
Upvotes: 1
Reputation: 49395
I am trying to make a macro in Outlook that will put a category on all the e-mails that have the same first 15 characters of the subject.
To find all items with the same Subject
string (with first 15 characters) you can use the Find
/FindNext
or Restrict
methods of the Items
class. Read more about these methods in the following articles:
Also you may consider using the Folder.GetTable method which obtains a Table
object that contains items filtered by filter. GetTable
returns a Table
with the default column set for the folder type of the parent Folder
. To modify the default column set, use the Add
, Remove
, or RemoveAll
methods of the Columns
collection object.
Sub RestrictTableOfInbox()
Dim oT As Outlook.Table
Dim strFilter As String
Dim oRow As Outlook.Row
'Construct filter for Subject containing 'your_15_characters'
Const PropTag As String = "https://schemas.microsoft.com/mapi/proptag/"
strFilter = "@SQL=" & Chr(34) & PropTag _
& "0x0037001E" & Chr(34) & " ci_phrasematch 'your_15_characters'"
'Do search and obtain Table on Inbox
Set oT = Application.Session.GetDefaultFolder(olFolderInbox).GetTable(strFilter)
'Print Subject of each returned item
Do Until oT.EndOfTable
Set oRow = oT.GetNextRow
Debug.Print oRow("Subject")
Loop
End Sub
Also you may take a look at the Application.AdvancedSearch method which performs a search based on a specified DAV Searching and Locating (DASL) search string. The key benefits of using the AdvancedSearch
method in Outlook are:
AdvancedSearch
method runs it automatically in the background.Restrict
and Find
/FindNext
methods can be applied to a particular Items
collection (see the Items
property of the Folder
class in Outlook).IsInstantSearchEnabled
property of the Store
class).Stop
method of the Search
class.Read more about that method in the Advanced search in Outlook programmatically: C#, VB.NET article.
Upvotes: 0