I want to delete an older email when a new message comes in (they have the same subject line).
This run a script sample is perfect to use with status reports and similar messages where you really only need to keep the most recent copy. For it to work, the messages need to have the same subject line (and the subject should be unique, because all messages matching the condition will be deleted.)
To use, create a Rule that checks the message subject and choose Run a Script as the action, selecting this script. The macro checks the Item.Subject, so if you need to run it on messages with different subjects you can use one rule.
While it only runs if Outlook is open, old messages won't pile up, as it deletes all older messages that meet the conditions when Outlook is open.
See Outlook's Rules and Alerts: Run a Script for more information on using Run A Script rules.
Sub DeleteOlderMessages(Item As Outlook.MailItem)
Dim objInbox As Outlook.MAPIFolder
Dim intCount As Integer
Dim objVariant As Variant
Set objInbox = Session.GetDefaultFolder(olFolderInbox)
' Remove these lines if you don't want to add a category
Item.Categories = "Delete Older"
Item.Save
For intCount = objInbox.Items.Count To 1 Step -1
Set objVariant = objInbox.Items.Item(intCount)
If objVariant.MessageClass = "IPM.Note" Then
If objVariant.Subject = Item.Subject And objVariant.SentOn < Item.SentOn Then
objVariant.Delete
Else
End If
End If
Next
Set objInbox = Nothing
End Sub
ItemAdd macro version
This version of the macro watches a specific folder for new items, in this example it is watching a subfolder under the Inbox. See Working with VBA and non-default Outlook Folders for code samples to use other folders.
This macro goes into ThisOutlookSession.
Option Explicit
Private objNS As Outlook.NameSpace
Private WithEvents objItems As Outlook.items
Private Sub Application_Startup()
Dim objWatchFolder As Outlook.Folder
Set objNS = Application.GetNamespace("MAPI")
'Set the folder and items to watch:
Set objWatchFolder = objNS.GetDefaultFolder(olFolderInbox).Folders("My Folder")
Set objItems = objWatchFolder.items
Set objWatchFolder = Nothing
End Sub
Private Sub objItems_ItemAdd(ByVal Item As Object)
Dim intCount As Integer
Dim objVariant As Variant
For intCount = objItems.Count To 1 Step -1
Set objVariant = objItems.Item(intCount)
If objVariant.Subject = Item.Subject And objVariant.SentOn < Item.SentOn Then
objVariant.Delete
Else
End If
Next
End Sub
How to use macros
First: You will need macro security set to low during testing.
To check your macro security in Outlook 2010 or 2013, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s at Tools, Macro Security.
After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.
Open the VBA Editor by pressing Alt+F11 on your keyboard.
To put the code in a module:
- Right click on Project1 and choose Insert > Module
- Copy and paste the macro into the new module.
More information as well as screenshots are at How to use the VBA Editor
More Information
More Run a Script Samples:
- Autoaccept a Meeting Request using Rules
- Automatically Add a Category to Accepted Meetings
- Blocking Mail From New Top-Level Domains
- Convert RTF Messages to Plain Text Format
- Create a rule to delete mail after a number of days
- Create a Task from an Email using a Rule
- Create an Outlook Appointment from a Message
- Create Appointment From Email Automatically
- Delegates, Meeting Requests, and Rules
- Delete attachments from messages
- Forward meeting details to another address
- How to Change the Font used for Outlook's RSS Feeds
- How to Process Mail After Business Hours
- Keep Canceled Meetings on Outlook's Calendar
- Macro to Print Outlook email attachments as they arrive
- Move messages CC'd to an address
- Open All Hyperlinks in an Outlook Email Message
- Outlook AutoReplies: One Script, Many Responses
- Outlook's Rules and Alerts: Run a Script
- Process messages received on a day of the week
- Read Outlook Messages using Plain Text
- Receive a Reminder When a Message Doesn't Arrive?
- Run a script rule: Autoreply using a template
- Run a script rule: Reply to a message
- Run a Script Rule: Send a New Message when a Message Arrives
- Run Rules Now using a Macro
- Run-a-Script Rules Missing in Outlook
- Save all incoming messages to the hard drive
- Save and Rename Outlook Email Attachments
- Save Attachments to the Hard Drive
- Save Outlook Email as a PDF
- Sort messages by Sender domain
- Talking Reminders
- To create a rule with wildcards
- Use a Macro to Copy Data in an Email to Excel
- Use a Rule to delete older messages as new ones arrive
- Use a run a script rule to mark messages read
- Use VBA to move messages with attachments
Carly says
Is there a video on how to do this?
Diane Poremsky says
No, but I will make one.
Steven says
Can this be done without the user of macros?
Diane Poremsky says
No, rules don't support this on their own.
Mark says
This is the only working solution I have found so far without installing any add ons! thanks!. Would it be possible to delete the new ones instead of keeping the latest?
J.A. Clark says
Hello - Appreciate all the macros and the work it took to compile all these. Nice that these macros work after 5+ years of being posted:-)
I have implemented the version called by an Outlook rule as well as the ItemAdd macro version and both work until they encounter an email that has the same date and time (which occasionally happens when I receive emails generated by an inhouse application). I've tried to modify the if statement controlling what emails are deleted based on the subject and time and can't seem to find the correct combination. What happens is neither email is deleted as neither email would match the if statement.
How can the macro (preferably the macro run by a rule) delete one of the matching emails with the same date and time?
Any assistance would be appreciated.
Pramod says
I m trying to use this script and it doesnt work. my current rule is set to move mails from a group to a folder(say group1) same level as Inbox.
i want to run this rule on group1 and my expectation are , it should delete an older email when a new message comes with the same Subject
Diane Poremsky says
Rules only run on the inbox. You can run it on the folder later and it should work. If you want it to work as the messages arrive, you need to move the message using the script - you cant mix actions and scripts.
you'll need to change this line to watch the folder:
Set objInbox = Session.GetDefaultFolder(olFolderInbox).parent.folders("group1")
to move the message, use this after the search:
item.move objInbox
Pramod says
Thanks , I use outlook 2016 . I have another question.
I have a folder called group1 , which has about 500 mails a day .
can you help me with a script which can keep the latest mail based on the subject.
Diane Poremsky says
I added an itemadd macro to the page - it will work better with high volume. You can use a rule to move mail into the folder and the itemadd will do the search. If there are a lot of messages in the folder to search, it will be slow - to speed it up, you can limit the search to the newest 50 messages or so.
Pramod says
when I run the script it gives me an error script ** doesn't exist or is invalid
Diane Poremsky says
are you using the run a script version or the new itemadd version?
The itemadd macro runs on its own, not in a rule.
Pramod says
I did a copy / paste of your Code "ItemAdd macro version" using ALT + F11 and saved them under "This OutlookSession" but I don't see any mails getting deleted. Do I need to do something else to make this work.
when I try to add it in rule I get the error mentioned in the previous post.
Diane Poremsky says
you either need to restart outlook or click in the application_startup macro and press Run.
Pramod says
Just to add, when I restart outlook
run-time error '-2147221233(8004010f)': The attempted operation failed. An object could not be found.
Debug pointing to
Set objWatchFolder = objNS.GetDefaultFolder(olFolderInbox).Folders("My Folder")
Diane Poremsky says
Do you have a subfolder of the Inbox called My Folder? If it can't find the folder, it definitely will error.
Pramod says
Yes I have them but it doesn't work.
Diane Poremsky says
if you get errors after restarting outlook... then its not macro security settings.
i don't know what to say - it is working on my test system.
Pramod says
Yes I fixed it , I added it as parent.folders but its not deleting mails on the folder.
Diane Poremsky says
Are the subjects identical and sent at an earlier time? If there are a lot of messages in the folder and high traffic, it can be overwhelming for the macro - you'll need to limit it to like the last 30 or 50.
I think this is how i did it when i had 3000+ messages and needed to limit it to recent messages (that macro is on my office computer) -
For intCount = objItems.Count To objItems.Count - 50 Step -1
Pramod says
Do I need to restart outlook everytime or does it run at the backend always?
Just wanted to thank you for all the help.
Diane Poremsky says
it runs in the background - but if you are editing it, you either need to restart outlook or click in the application run macro then click Run to kick start it with the changes.
Pramod says
Thanks, Last Query :
Can you do this for 2-3 Folders in Parallel ?
Diane Poremsky says
You can - you need to reference each folder in the application startup macro and create an itemadd macro for each. You can do it something like this and to share the macro that does the work -
Private Sub objItems_ItemAdd(ByVal Item As Object)
FindDuplicates item
End sub
Private Sub objItemsFolder_ItemAdd(ByVal Item As Object)
FindDuplicates item
End sub
Private Sub FindDuplicates(ByVal Item As Object)
Dim intCount As Integer
Dim objVariant As Variant
For intCount = objItems.Count To 1 Step -1
Set objVariant = objItems.Item(intCount)
If objVariant.Subject = Item.Subject And objVariant.SentOn < Item.SentOn Then objVariant.Delete Else End If Next End Sub
Arun says
Rule in Outlook: Mail from Public Group Move to Folder say Time.
Need a Script to run on the Folder (Time) which will keep latest mail on a particular Subject and move the remaining one to a new folder(say Time1)
Diane Poremsky says
This assumes the Time and time1 folders are a subfolder of the inbox:
Set objInbox = Session.GetDefaultFolder(olFolderInbox).folders("Time")
Set objTime1 = Session.GetDefaultFolder(olFolderInbox).folders("Time1")
then change objVariant.Delete to
objVariant.move objTime1
objVariant.Delete
Carlo Borreo says
I am not sure I understand. Is your script:
a) Deleting all emails with the same subject of a newer email, whatever is the subject
OR
b) Deleting all emails with the same specific subject X of a newer email
Diane Poremsky says
It's a run a script rule, so you'd use whatever condition you want to limit the messages that are touched by the script - it can be sender, subject - any available rule condition. If an incoming message meets the conditions in the rule, the macro looks for older messages matching the subject of the new message.
If you want it to apply to all messages, leave the rule conditions blank.
Kim says
Thanks for all your scripts! Very helpful!
Hoping you can give me some guidance ...
I'm trying to use an existing script but need to make an adjustment or two ... using DeleteOlderMessages ...
I need the script to categorize the incoming email as 'Most Recent' but then change the category to '*Disregard' when it's deleted ...
and I'd rather move that email to another folder instead of deleting it ... i'm having the biggest issue with changing the category upon moving/deleting ...
any suggestions?
Diane Poremsky says
you may need to change it before moving and may need to save the message after setting the category.
' Remove these lines if you don't want to add a category
Item.Categories = "Most Recent"
Item.Save
and
If objVariant.Subject = Item.Subject And objVariant.SentOn < Item.SentOn Then objVariant.categories = "Disregard" objvariant.save ' move code goes here
Kim says
Perfect! thanks!
Paul says
I'm having trouble getting this to run on a different folder, not a subfolder. When the e-mail comes in I have a rule set up to move it to a "Reports" Folder. I'd like this to run on the Reports folder instead of the inbox. Any ideas?
Thanks,
Paul
Diane Poremsky says
if its at the same level as the inbox, try using Set objInbox = Session.GetDefaultFolder(olFolderInbox).parent.folders("name")
if that fails, you'll need to use an itemadd macro to watch the folder
Jerry Kaminsky says
First let me say I appreciate all you do to make the lives or the programming challenged more pleasant. I used the above code *delete older message when new one arrive with same subject line) and for some reason my mail freezes. I am wondering if one of my add-ins like Autonomy could be causing this? Any ideas on why it would be freezing
Diane Poremsky says
The macro can cause outlook to freeze for a couple of seconds or so, as it searches the inbox for matches. It might hang a bit longer if the mailbox has a lot of messages to search through. It should unfreeze on it's own. I don't think the addin will affect it, but it's possible.
Ryan says
Sorry Diane, You are speaking a different language than me, I appreciate you trying though.
Ryan says
I don't get the option to run a script. Thanks
Diane Poremsky says
Scripts with names in this format:
sub macroname (item as outlook.item)
can only be run from other macros or using rules.
if the name is in this format:
public sub macroname()
then you can run it any time in the editor or from the macro list.
Ryan says
Can't believe I am so close to finding a solution to this issue. I just need a little more (step by step) detail on setting this up. I am using Office 2013. Please help. This would be a life saver
Diane Poremsky says
This is a script for a run a script rule - paste it into the VB Editor and create a rule. See https://www.slipstick.com/outlook/rules/outlooks-rules-and-alerts-run-a-script/ for more details and screenshots.
Peter M says
Hi. Thank you very much. I am using your script exactly as it is and it is very helpful. Unfortunately, in the morning and especially after the weekend (so after the computer was running without interaction for many hours) i receive this error between once and many times:
Microsoft Visual Basic
Run-time error '[numbers here]'
Method 'SentOn' of object '_MailItem' failed
and when i click on Debug it highlights this line:
If objVariant.Subject = Item.Subject And objVariant.SentOn < Item.SentOn Then
and it seems that objVariant is NULL at this point so he can't get the SentOn
can you help? what can i change in the script?
thank you very much!
Peter
Diane Poremsky says
If there are a lot of messages to process, it can fail because Outlook is downloading messages and the message count changes, confusing the script. The easiest fix is to add On Error Resume Next right before the line that fails - when it errors, it should skip to the next message.
Peter M says
Thank you very much! I will try this.
Netpilot says
Hi Diane,
This script is SO close to what I've been trying to figure out how to do with new RSS items from a VBA script!
We all know of the problem that Outlook has with receiving duplicate items from certain RSS feeds, depending on how the RSS server is configured. A new duplicate RSS item appears to have the same "From", "Subject", and date "Received" values, but has a newer date "Modified" value.
When a new RSS item arrives, I'd like a VBA macro to delete all items in that folder which have the same From, Subject, and date Received values, but an older date Modified.
I have had two problems figuring out how to do this:
1) RSS items go into their own folder - this script assumes the item will be in the Inbox. Is there a way to trigger a script that processes only items in an RSS folder when a new item arrives?
2) The script you wrote seems to iterate through and compare the new message to all of the previous items in the folder. With hundreds, or possibly thousands, of items in a folder, that could take a long time, especially when executing in real-time while new items are being received. Is there a way in Outlook VBA to iterate through the items in, say, date Received order so the iteration could stop when the compared date Received is older than the date Received of the new message?
You would be a hero to many, many people if you came up with a script to solve this problem!
Thanks in advance.
Diane Poremsky says
I think the answer for both is No, but will look into it - it would be handy for me too. :) I have a feed that gets a lot of duplicates - i can stop it by setting Outlook to not treat changed items as new but I need the changed items, just not 200 copies. :)
Netpilot says
Thanks for your reply. Yeah, the 'Don't treat changed items as new' setting doesn't do what we want. And anyone I know who uses feeds has at least one offender. :)
Well, I've considered a workaround for #1 - Configure RSS settings to have items from all offending feeds go into a generic RSS folder named 'RSS Inbox', so you know where it lands. Then have a rule with a condition that checks for RSS items from all offending feeds by Feed Name (aka Title), then runs a script.
The script would be hard-coded to look at the new item, and with a Select Case, based on the Feed Name, move it to its associated folder (same as the Feed Name by default), then compare older items in that folder against it, deleting as appropriate. Kind of messy, but gets the job done.
The part I really don't know how to do is #2 - avoid iterating through all items in the associated folder. Is it possible to order, hash, or somehow sort the collection of obj[DestinationFolder].Items by date Received so that the search for duplicates can be stopped in a reasonable amount of time?
Actually, I'm not even sure if scripts are run synchronously or asynchronously, i.e.., does Outlook wait until a script is finished before processing more rules on that item or any rules on the next incoming item? If it does not wait, the script had better be really well optimized.
M.Sornamuthu says
Dear Ms Diane Poremsky,
Thanks for the above code
Can you please give me the code which can run in all sub folders
thanks
M.Sornamuthu
Diane Poremsky says
I'm sorry, I don't have a very of this that runs on all subfolders. You might be able to use the processfolder sub. You'd call it using
processFolder (objNS.GetDefaultFolder(olFolderInbox))
Private Sub processFolder(ByVal oParent As outlook.MAPIFolder)
Dim oFolder As outlook.MAPIFolder
' do whatever here
If (oParent.Folders.Count > 0) Then
For Each oFolder In oParent.Folders
Call processFolder(oFolder)
Next
End If
End Sub