Solved: Outlook 2010: imap subfolder: automatically delete specific messages after 'x' days

[dougbert]

Hi all,

I've browsed this forum and found a lot of help over the past year or so. However, this is my first post, primarily because it's an Outlook request for code and I haven't done but one macro for Outlook previously.

Issue: I don't want to use AutoArchive for this solution. Why? Because, I use Outlook to receive my Gmail (IMAP). At this point, I only want to manipulate certain messages in Gmail. I don't want AutoArchive to archive everything I have stored on the Gmail servers to my local HD. I tried implementing an AutoArchive, 'permanently delete' on a single folder, but Outlook popped up and made me create a default AutoArchive profile. I canceled that, or I'd have to tag every folder but the one I want to archive as "Do Not Archive". That might be a hassle to manage as I add new folders to Gmail.

However, I'd like a macro to manipulate the messages on the Gmail server. I figure if I can delete/add Gmail folders/message via Outlook, this should be possible.

What I want: I have a rule set up in Outlook to move messages coming from a single sender into a subfolder named 'SI' under the Gmail folders. They are the type of messages that if you haven't read them in 'x' days, they are no longer relevant and I'd like them automatically deleted every 'x' days whether I've read them or not. I may remain logged into Outlook on this computer for days/weeks at a time, if that matters to the solution.

Similar thread: vbaexpress.com/forum/showthread.php?t=1267
my post count is too low to use a link, so I improvised Moderator: Not trying to violate forum rules, just trying to show I've done my homework and share that result with viewers. The reason I can't easily leverage this code is due to the IMAP component of my issue. I have no idea of what the syntax and code are for IMAP.

I'd appreciate any assistance on tackling this code.

Thanks!

[dougbert]

Well, for not having written an Outlook macro for awhile, I've gotten pretty far, but I need my sleep. So, I'm going to post what I have so far, as it works...sort of.

The goal of this macro for me personally is probably pretty trivial to you. However, I believe the concept is what is important to this forum. So, here's the dirt. I receive almost daily an e-mail from Sports Illustrated that always begins with "SI Extra: " in the subject line. By rule, I'm moving them to a Gmail folder named, "SI". So, the intent of my macro is to run it on the "SI" folder, and automatically delete ALL of the outdated (older than a week) messages.

After leveraging the code at the vbaexpress link in my introductory post and another few lines I found at vbaexpress.com/forum/showthread.php?t=35691 written in German, this is what I have. It seems to at least work half way. What I mean is I drug 10 old deleted SI messages out of my Gmail 'Trash' folder into the SI folder, and included a couple of messages received within the week. When I run the code, it leaves the newer messages alone, but only deletes half of the older messages starting with the oldest half of those messages. If I re-run the code, it will delete half of the remaining outdated messages and so on. I just can't seem to find the part of my code that 'skips' the newer half of the oldest messages.

I considered 'moving' the outdated messages into the Gmail 'Trash' folder, but couldn't figure out the path to the Trash folder.

I've tried placing a message box in place of the deletion code and it identifies each and every message that should be deleted, but the real code still skips the newest half of the outdated messages. Please let me know if this isn't clear and I'll type in an example.

I should also note that Gmail is my default e-mail account for sending messages from Outlook, if that plays into this at all, though I suspect not.

Sub RemoveOldSI()
     'Deletes messages from Sports Illustrated that have "SI Extra: " 
     'in the subject line and are older than 1 week.
    Dim olSession As Outlook.Application, olNamespace As NameSpace
    Dim olInbox As Outlook.MAPIFolder
    Dim olItem As MailItem
    Set olSession = New Outlook.Application
    Set olNamespace = olSession.GetNamespace("MAPI")
    Set olInbox = olNamespace.GetDefaultFolder(olFolderInbox)
    Set olOtherInbox = Session.Folders("MyGmailAccountName@gmail.com")
 
    For Each olItem In olOtherInbox.Folders("SI").Items
        If TypeName(olItem) = "MailItem" Then
            If InStr(1, olItem.Subject, "SI Extra: ", vbTextCompare) _
            And InStr(1, olItem.SenderName, "Sports Illustrated", vbTextCompare) Then
                If olItem.ReceivedTime < Date - 6 Then
                    olItem.Delete
                End If
            End If
        End If
    Next
 
    Set olSession = Nothing
    Set olNamespace = Nothing
    Set olInbox = Nothing
    Set olOtherInbox = Nothing
 
End Sub

If I/we can get the code working properly, I intend to place it in the ThisOutlookSession code, attempting to completely automate the macro each time I either login or out of Outlook.

I appreciate any suggestions on how to modify.

[dougbert]

Well, they say if you want something done right...do it...

After spending some time on MSDN on a page entitled "Working with Members of an Items Collection", I finally got enough information to create working code.

I tested the code by placing 21 messages from Sports Illustrated in the "SI" folder. 19 of the messages were older than 1 week. Additionally, I placed a few messages that were newer and older than 1 week from a different sender with a different subject line in the same folder. On a single pass,the code deleted all but the 2 newest messages from Sports Illustrated and the 3 completely different messages. Yee-haw! Remember: it won't run quickly, as you're working with an imap server, instead of an Exchange server, but it does work! All the deleted mail items showed up in the Gmail 'Trash' folder.

There's only one issue remaining before I can move it to ThisOutlookSession. If I'm looking at the Outlook interface, specifically the 'SI' folder and I press <Alt-F8> to bring up the Macro Menu, and attempt to run the macro, I jump to the VBE and the message says 'Sub or Function not defined'. However, if I start from VBE code itself and just press <F5> to run the sub, it works just fine!!! Can anyone help me with that?

Anyways, I thought I'd share my code with the forum.

Here's the working code:

Public Sub RemoveOldSI()
     'Deletes messages from Sports Illustrated that have "SI Extra: "
     'in the subject line and are older than 1 week.
    Dim olSession As Outlook.Application, olNamespace As NameSpace
    Dim olInbox As Outlook.MAPIFolder
    Dim olFolder As MAPIFolder
    Dim SI_Items As Items
    Dim i As Integer
    Set olSession = New Outlook.Application
    Set olNamespace = olSession.GetNamespace("MAPI")
    Set olInbox = olNamespace.GetDefaultFolder(olFolderInbox)
    Set olOtherInbox = Session.Folders("MyGmailAccountName@gmail.com")
    Set olFolder = olOtherInbox.Folders("SI")
    Set SI_Items = olFolder.Items
 
    For i = SI_Items.Count To 1 Step -1
        If TypeName(SI_Items.Item(i)) = "MailItem" Then
            If InStr(1, SI_Items.Item(i).Subject, "SI Extra: ", vbTextCompare) _
            And InStr(1, SI_Items.Item(i).SenderName, "Sports Illustrated", vbTextCompare) Then
                If Date - SI_Items.Item(i).ReceivedTime > 6 Then SI_Items.Item(i).Delete
            End If
        End If
    Next
 
    Set olSession = Nothing
    Set olNamespace = Nothing
    Set olInbox = Nothing
    Set olOtherInbox = Nothing
    Set olFolder = Nothing
    Set SI_Items = Nothing
End Sub

I hope other members of the forum may find this code useful for their projects.

-dougbert

[dougbert]

OK, now I solved the 'Sub or Function undefined' message I was receiving when trying to execute my macro from the macro menu. I added 'Option Explicit' to my code thinking I might need some as yet unknown Reference Library, but that still didn't identify any issues when I compiled the code.

I had previously used the following 'technique', but forgot about it until I found it again in my web search results while looking for the answer. Incredibly simple. I copied my code and pasted it into a new module. Runs like a charm.

Now, my challenge is to move this into the ThisOutlookSession module for complete automation. I'll post back, once I learn what I need to know. Unless, of course, one of you fine forum viewers have the answer and would consider a reply.

[dougbert]

Since there haven't been any replies or comments, I'm not sure if what I've learned and coded has been useful to anyone, but I feel technically obligated at this point to complete the solution and share it with the forum. I know if you're anything like me, once you find the solution you're looking for, you leverage the code and move on without a thought about the individual who made your life a little easier. Sometimes, it gets very lonely in cyberspace.

Anyways, I've completed the entire solution I was seeking when I asked it in my first post. I used the same test scenario in my post #3. So, there were over 20 messages in the 'SI' folder when I restarted Outlook with the macro below in place within ThisOutlookSession.

Here's what happens: When you first launch Outlook 2010, the splash banner appears and you'll see what Outlook is loading as it loads. My macro gets processed immediately after I see 'Loading Profiles' during the next item which just says 'Processing' with animated, serially recurring ellipses (...) following the word. Since this is processing on an IMAP server, it takes several seconds to complete. Once it's done, Outlook finishes loading normally. I checked the 'SI' folder and all test messages were processed exactly as I desired.

Here's all the code I placed in ThisOutlook Session. Modify to suit your purpose.

Private Sub Application_MAPILogonComplete()
    RemoveOldSI
End Sub
Private Sub RemoveOldSI()
     'Deletes messages from Sports Illustrated that have "SI Extra: "
     'in the subject line and are older than 1 week.
    Dim olSession As Outlook.Application, olNamespace As NameSpace
    Dim olInbox As Outlook.MAPIFolder
    Dim olOtherInbox As Outlook.MAPIFolder
    Dim olFolder As MAPIFolder
    Dim SI_Items As Items
    Dim i As Integer
    Set olSession = New Outlook.Application
    Set olNamespace = olSession.GetNamespace("MAPI")
    Set olInbox = olNamespace.GetDefaultFolder(olFolderInbox)
    Set olOtherInbox = Session.Folders("MyGmailAccountName@gmail.com")
    Set olFolder = olOtherInbox.Folders("SI")
    Set SI_Items = olFolder.Items
 
    For i = SI_Items.Count To 1 Step -1
        If TypeName(SI_Items.Item(i)) = "MailItem" Then
            If InStr(1, SI_Items.Item(i).Subject, "SI Extra: ", vbTextCompare) _
            And InStr(1, SI_Items.Item(i).SenderName, "Sports Illustrated", vbTextCompare) Then
                If Date - SI_Items.Item(i).ReceivedTime > 6 Then SI_Items.Item(i).Delete
            End If
        End If
    Next
 
    Set olSession = Nothing
    Set olNamespace = Nothing
    Set olInbox = Nothing
    Set olOtherInbox = Nothing
    Set olFolder = Nothing
    Set SI_Items = Nothing
End Sub

This will be my final post on this thread, unless someone/anyone has questions or comments. I hope it will make someone's day when they find this in a search. Bring on the Karma!!!

-dougbert