Macro to delete old emails from same sender

[Mr Octopus]

Hi there. Sorry, I'm a complete VBA newbie, so forgive any idiot questions that follow.

First off, I'm using Outlook 2010.

I work in a company where I receive multiple emails a day from one sender, all with the same subject line. The most recently received email renders all previous emails redundant, and at the moment it's proving to be an arduous task to keep manually deleting all emails but the newest one.

I did a search around these forums and found this thread: forum/showthread.php?t=1267, which seems to answer my question. (Sorry, I can't post links due to my low post count, apparently).

Being a complete VBA novice, I tried to just copy/paste the code that seemed to fit me best, and change out the fields I thought were relevant. That doesn't seem to have worked (surprise surprise).

Here's the code I was trying to use (this is the original code I copy/pasted from user: mdmackillop, not my altered version where I probably screwed it completely up):


Sub KillDupes()
'Needs a reference to Microsoft Scripting Runtime
Dim olSession As Outlook.Application, olNamespace As NameSpace
Dim olInbox As Outlook.MAPIFolder, olDupe As Outlook.MAPIFolder
Dim MyolInbox As Outlook.MAPIFolder
Dim olItem As MailItem
Dim olDict As Dictionary
Dim MS, MySubs
MySubs = Array("EE", "VBA")

Set olSession = New Outlook.Application
Set olDict = New Scripting.Dictionary
Set olNamespace = olSession.GetNamespace("MAPI")
Set olInbox = olNamespace.GetDefaultFolder(olFolderInbox)

For Each MS In MySubs
Set MyolInbox = olInbox.Folders(MS)

On Error Resume Next
Set olDupe = olInbox.Folders("Old")
If Err <> 0 Then Set olDupe = olInbox.Folders.Add("Old")
On Error Goto 0
For Each olItem In MyolInbox.Items
If TypeName(olItem) = "MailItem" Then
If olDict.Exists(olItem.Subject & olItem.SenderName) Then
'if the subject exists test to see which message is newer
If olItem.ReceivedTime > olDict(olItem.Subject & olItem.SenderName) Then
MyolInbox.Items(olItem.Subject).Move olDupe
olDict.Remove olItem.Subject & olItem.SenderName
olDict.Add olItem.Subject & olItem.SenderName, olItem.ReceivedTime
Else
' move the current item if it is older
olItem.Move olDupe
End If
Else
olDict.Add olItem.Subject & olItem.SenderName, olItem.ReceivedTime
End If
End If
Next
Next
Set olDict = Nothing
Set olSession = Nothing
End Sub


I currently have an Outlook rule set up that automatically transfers all emails from "example@mail.com" (for argument's sake) to a sub-folder in my Inbox. All of those emails have the same subject line "Test Mail", though that isn't included in the rule. I imagine this Outlook rule would be made redunant by the right macro, but I would still need the newest "Test Mail" from "example@mail.com" to go into its own sub-folder branching from my Inbox (followed by the deleting of any older emails within that sub-folder that match the sender and subject. I hope that makes sense).

Where am I slipping up with this code? I know close to nothing about what I'm doing. Just trying to muddle my way through changing fields that looked like they might work. :rotlaugh:

Cheers for any help!

[dougbert]

Hi Mr Octopus,

Welcome to the board. I'm new here as well.

Please mark this thread as 'Solved' by choosing Thread Tools just above the first message you posted, if my solution works for you.

Please also visit my posted thread for another variation using IMAP subfolders at: http://www.vbaexpress.com/forum/showthread.php?t=38458

Leave your existing rule for this sender in place, and modify my code below in what I hope are the obvious places, specifically "Test Mail", "Test Mail folder" and example@mail.com. I'm also making the assumption that "Test Mail folder" is a subfolder underneath the Inbox. Let me know, if you have any issues.

The code as presented below is intended to be pasted into the ThisOulookSession module. You'll find that when you expand Microsoft Outlook Objects in the VBE. Close Outlook and make sure you save the VBAProject.OTM when it prompts you.

Wait a few seconds and re-open Outlook. Right after you see 'Loading Profile' in the Outlook splash banner, you'll VERY briefly see 'Processing...'. That means your login has completed and it processed my macro VERY quickly.

You can now use this macro in 2 ways:
1.) It will process your "Test Mail folder" automatically every time you open Outlook. Only the most recent message will remain. This might be good enough for you as it will be very automatic and will manage the older items each time you login. BUT... if your sender has sent you multiple emails since the last time you logged in, they will all appear along with the single, most recent email preceding them. That is because this module is processed BEFORE your new incoming mail items. If there are several new messages and you want to clean up the "Test Mail folder", you can use...
2.) Once Outlook has finished loading, press <Alt-F8> keys at the same time. You'll see the 'RemoveAllButNewest' macro as I made it a Public macro. Run it and only the most recent message will remain.

This code only deletes messages from your example@mail.com sender and only if they contain the words "Test Mail" in the subject AND only if they aren't the newest message of "Test Mail". It will leave any other messages in your "Test Mail folder" folder alone.

So, this should cover your desired folder maintenance one way or the other.

This code doesn't require any additional Reference Libraries.

Here's the code:



Private Sub Application_MAPILogonComplete()
RemoveAllButNewest
End Sub
Public Sub RemoveAllButNewest()
'Deletes messages from example@mail.com that have "Test Mail"
'in the subject line and are older than the newest message.
Dim olSession As Outlook.Application, olNamespace As NameSpace
Dim olInbox As Outlook.MAPIFolder
Dim olFolder As MAPIFolder
Dim olItems As Items
Dim i As Integer

Set olSession = New Outlook.Application
Set olNamespace = olSession.GetNamespace("MAPI")
Set olInbox = olNamespace.GetDefaultFolder(olFolderInbox)
Set olFolder = olInbox.Folders("Test Mail folder")
Set olItems = olFolder.Items

If olItems.Count <= 1 Then GoTo Release ' don't want to delete anything if there's a single message or no messages in folder
olItems.Sort ("ReceivedTime") ' sort all current items by received time in descending order
olItems.GetLast
For i = olItems.Count To 1 Step -1
If TypeName(olItems.Item(i)) = "MailItem" Then
If InStr(1, olItems.Item(i).Subject, "Test Mail", vbTextCompare) _
And InStr(1, olItems.Item(i).SenderEmailAddress, "example@mail.com", vbTextCompare) Then
If olItems.Item(i) <> olItems.GetLast Then
olItems.Item(i).Delete
End If
End If
End If
Next
Release:
Set olSession = Nothing
Set olNamespace = Nothing
Set olInbox = Nothing
Set olFolder = Nothing
Set olItems = Nothing
End Sub


I hope this is the answer you were looking for. If so, please feel free to return the favor by visiting my thread, and using the Thread Tools pull-down menu to rate my thread.

Enjoy!
-dougbert

[Mr Octopus]

I'm also making the assumption that "Test Mail folder" is a subfolder underneath the Inbox. Let me know, if you have any issues.

-dougbert

Hi Dougbert,

Thanks for this - it's the best response I've had so far. Unfortunately, it doesn't seem to be working for me just yet.

Yes, the "Test Mail folder" is a sub-folder within my Inbox.

I've copy/pasted your code and altered the fields which appeared relevant. I closed Outlook and saved when prompted. When re-opening Outlook, I didn't see "Processing..." but I did get an error message containing:


"Microsoft Office has identified a potential security concern.
This Outlook Session
Macros havebeen disabled."

I click on "Enable Macros", as "Trust all documents from this publisher" is ghosted.

After this, a second error appears:


"A program is trying to access email address information stored in Outlook. If this is unexpected, click Deny and verify your antivirus software is up-to-date."

I have a choice to allow it access for 1 minute up to 10 minutes, so I allow it 10 mins.

Sounds like generic "are you sure you want to do this" messages, but just thought I'd share in case that's a part of the problem (and to see whether there's a way to get rid of these messages in the future).

After dealing with these messages... nothing happens. I tried ALT+F8 and running the Macro I created, but this doesn't seem to have any effect either.

I'll post the code I'm using below, with the alterations I've made so that you can see whether I've messed it up or not ;)

The sub-folder is called "ControlRoom", the sender's email is Control.Room@xxxxx.co.nz and the subject line is "Network Status Notification".


Private Sub Application_MAPILogonComplete()
RemoveAllButNewest
End Sub
Public Sub RemoveAllButNewest()
'Deletes messages from Control.Room@xxxxx.co.nz that have "Network Status Notification"
'in the subject line and are older than the newest message.
Dim olSession As Outlook.Application, olNamespace As NameSpace
Dim olInbox As Outlook.MAPIFolder
Dim olFolder As MAPIFolder
Dim olItems As Items
Dim i As Integer

Set olSession = New Outlook.Application
Set olNamespace = olSession.GetNamespace("MAPI")
Set olInbox = olNamespace.GetDefaultFolder(olFolderInbox)
Set olFolder = olInbox.Folders("ControlRoom")
Set olItems = olFolder.Items

If olItems.Count <= 1 Then GoTo Release ' don't want to delete anything if there's a single message or no messages in folder
olItems.Sort ("ReceivedTime") ' sort all current items by received time in descending order
olItems.GetLast
For i = olItems.Count To 1 Step -1
If TypeName(olItems.Item(i)) = "MailItem" Then
If InStr(1, olItems.Item(i).Subject, "Network Status Notification", vbTextCompare) _
And InStr(1, olItems.Item(i).SenderEmailAddress, "Control.Room@xxxxx.co.nz", vbTextCompare) Then
If olItems.Item(i) <> olItems.GetLast Then
olItems.Item(i).Delete
End If
End If
End If
Next
Release:
Set olSession = Nothing
Set olNamespace = Nothing
Set olInbox = Nothing
Set olFolder = Nothing
Set olItems = Nothing
End Sub


For what it's worth, all the emails I get from this sender's address are always "Network Status Notification", and they're the only people who send me emails with this subject line. I'm just wondering if it would make things easier to only filter through either the sender's email OR the subject line, rather than both. Just a thought.

Any ideas?

And cheers for all your help.

[dougbert]

Hi Mr. Octopus,

I've tested this macro by sending numerous e-mails at different times, plus 3 messages within a few seconds of each other from my gmail account to my Comcast MAPI account. It works flawlessly and seamlessly.

First, I just want to confirm that you pasted my code into the ThisOutlookSession module. Verify by double-clicking on the TheOutlookSession. The code should then appear in the code pane.

Second, Outlook has no idea who the Publisher is. When you copy/paste my code into Outlook, it's as if you had written it yourself. So, since you can see my code is clearly not malicious, here's what I'd suggest, at least for testing purposes. In Outlook 2010, click File, Options, Trust Center, Trust Center Settings, Macro Setttings and choose Enable All Macros. You can certainly change this back after testing, but if the code works with this setting, then this is an option.

WARNING: I experimented with creating a self-signed digital certificate to sign my macro, so you could choose the digitally signed macro settings option. I've used this on an Excel macro I wrote at work. However, I somehow ended up corrupting my Outlook, so that I can't run macros any longer, even after removing the certificate from Outlook and IE Explorer. So, I suggest getting a commercial digitally signed certificate if you need to do this.

Looks like I now have my own new problem to solve.

I hope enabling all macros is all it takes to get you up and running.

-dougbert

[Mr Octopus]

Hi dougbert,

Cheers for the continued help.

I've verified that I'm pasting the VBA code into the right place.

I suspect there's something in my company's network settings that might be blocking macros, or this specific macro for some reason, or is just messing with me in some way (though I'm not receiving any error messages to indicate this).

If I wanted this macro to only apply to things received under the subject "Network Status Notification", and forget the sender's email filter, which lines in the code would I have to delete/alter?

Also, is there any kind of simple test macro I could create to test that macros are working in my Outlook at all?

[dougbert]

Hi Mr Octopus,

I'm assuming you enabled ALL macros for testing purposes under Macro Settings as I mentioned above. Since the macro's in the correct module that's all it should take. The macro should work fine. I'm also assuming that you left the rule in place that moves the message from this sender into your ControlRoom folder and that the rule is working correctly. I'm also assuming that you after you pasted the macro, you compiled the code via Debug, Compile. ONLY email can be in this folder (no calender, tasks, etc.)

Also, click Tools, References. You should have at least these items checked as these are the ones I had in place when I wrote this:

Visual Basic for Applications
Microsoft Outlook 14.0 Object Library
Microsoft Office 14.0 Object Library
OLE AutomationOne more thing to try. Step through the Public macro code (not the Private Sub Application_MAPILogonComplete() sub) by clicking in the Public sub code, then press <F8> key repeatedly as it steps through the code, highlighting each line with yellow. If you don't receive any error after a couple of times through the loop portion of the code, press <F5> and see if it will complete the code on its own. If it completes without error, look in the ControlRoom subfolder to see the results. If it looks like you hoped it would, the macro is just fine and there is some other issue. This is a much better "test" than a new "test macro".

If none of these work, I don't have much, if any, hope that the following will work.

Here's the code without checking for the sender's email address, although that shouldn't be stopping this from running correctly. Since it's "new code", be sure to compile it before running it. You should always recompile your code any time you make changes, as long as 'compile' isn't greyed-out.



Private Sub Application_MAPILogonComplete()
RemoveAllButNewest
End Sub
Public Sub RemoveAllButNewest()
'Deletes messages that have "Network Status Notification"
'in the subject line in the ControlRoom subfolder and are older than the newest message.
Dim olSession As Outlook.Application, olNamespace As NameSpace
Dim olInbox As Outlook.MAPIFolder
Dim olFolder As MAPIFolder
Dim olItems As Items
Dim i As Integer

Set olSession = New Outlook.Application
Set olNamespace = olSession.GetNamespace("MAPI")
Set olInbox = olNamespace.GetDefaultFolder(olFolderInbox)
Set olFolder = olInbox.Folders("ControlRoom")
Set olItems = olFolder.Items

On Error GoTo Release ' added this for error handling

If olItems.Count <= 1 Then Goto Release ' don't want to delete anything if there's a single message or no messages in folder
olItems.Sort ("ReceivedTime") ' sort all current items by received time in descending order
olItems.GetLast ' identify most recent item. In this case it needs to be an e-mail
For i = olItems.Count To 1 Step -1
If TypeName(olItems.Item(i)) = "MailItem" Then
If InStr(1, olItems.Item(i).Subject, "Network Status Notification", vbTextCompare) Then
If olItems.Item(i) <> olItems.GetLast Then
olItems.Item(i).Delete
End If
End If
End If
Next i
Release:
Set olSession = Nothing
Set olNamespace = Nothing
Set olInbox = Nothing
Set olFolder = Nothing
Set olItems = Nothing
End Sub


As you can see, not much changed in the code, and I doubt this would make the difference.

Let me know your results after trying all the above suggestions.

-dougbert