Macro to Delete Emails Older than x Days Old 2

[dapoole]

Hello Gurus

So far I have created a macro (code below) that when run deletes emails directly from the 'Drafts' folder, however I want to add the condition that it only deletes emails 'older than 2 days old'. Can anyone advise on how I can add this into my macro below.

All help greatly appreciated.

David.

-------------------------
Public Sub EmptyDraftsEmailFolder()

Dim outapp As Outlook.Application
Set outapp = CreateObject("outlook.application")
Dim olitem As Object
Dim fldDrafts As Outlook.MAPIFolder

Set fldDrafts = outapp.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts)
For Each olitem In fldDrafts.Items
olitem.Delete
Next

Set fldDrafts = Nothing
Set olitem = Nothing
Set outapp = Nothing

End Sub
---------------------------------------

 

[fumei]

Change olitem from Object, to MailItem - as that is what it is. It is a MailItem in the Draft Folder. Declaring it explicitly as a MailItem opens up Itellisense properties and methods dropdown.

For Each olitem In fldDrafts.Items
  If DateDiff("d", olitem.CreationTime, Now) > 2 Then     olitem.Delete

Gerry

 

[dapoole]

Thank you very much. It now works a treat.

 

[dapoole]

Hi Gerry

Sorry I the above does work for the Drafts folder, however I was only using that one to test against as I actually want to apply the macro to the following mailbox and subfolder:

-SystemOperationsMailbox
-Inbox
-Administrators
-DBA Database Info

However if I substitute the 'Drafts' folder name for DBA Database Info it obviously doesnt work. So my questions are:

1. If I am logged into my own Mailbox how do I get the macro to run from my mailbox in the sub folder 'DBA Database Info' in the 'System Oerations' one?
2. Can the macro have spaces between words for folder names (i.e. Can I have DBA Database Info, or does the folder have to be called DBADatabaseInfo)

Thanks in advance.

David

 

[dapoole]

So far I have got:


Public Sub EmptyDBADatabaseInfoEmailFolder()

Dim nsSession As NameSpace
Dim fldInbox As Outlook.MAPIFolder
Dim fldDBADatabaseInfo As MAPIFolder
Dim olitem As Object

Set nsSession = ThisOutlookSession.Session
Set fldInbox = nsSession.GetDefaultFolder(olFolderInbox)
Set fldDBADatabaseInfo = fldInbox.Folders("DBADatabaseInfo")


For Each olitem In fldDBADatabaseInfo.Items
If DateDiff("d", olitem.CreationTime, Now) > 2 Then olitem.Delete
Next

Set nsSession = Nothing
Set fldInbox = Nothing
Set fldDBADatabaseInfo = Nothing
Set olitem = Nothing

End Sub


Which runs without error but does not appear to deleted them. :/

 

[TonyJollans]

Hi dapoole,

I'm not totally clear about the location of your folder, but you should be able to be explicit about it ..

[blue]    Public Sub EmptyDBADatabaseInfoEmailFolder()

        Dim nsSession As NameSpace
        Dim fldDBADatabaseInfo As MAPIFolder
        Dim olitem As Object
        
        Set nsSession = ThisOutlookSession.Session
        Set fldDBADatabaseInfo = nsSession.Folders("SystemOperationsMailbox").Folders("Inbox").Folders("Administrators").Folders("DBA Database Info")

        
        For Each olitem In fldDBADatabaseInfo.Items
        If DateDiff("d", olitem.CreationTime, Now) > 2 Then olitem.Delete
        Next
       
        Set nsSession = Nothing
        Set fldDBADatabaseInfo = Nothing
        Set olitem = Nothing

    End Sub[/blue]

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.
Excel VBA Training and more Help at VBAExpress[

 

[dapoole]

Hi Tony/Gerry

Okay the following code runs however it is not removing the old emails. For simlicity I have tried to set it up in my mailbox, inbox, and dbadatabaseinfo folder first. But it doesnt appear to want to play ball. Grr! The path to the folder is: "Mailbox - Poole, David" > "Inbox" > "DBADatabaseInfo"

I must be missing something small here. Please help.

Cheers
------------------------------------------------
Public Sub EmptyDBADatabaseInfoEmailFolder()

Dim nsSession As NameSpace
Dim fldDBADatabaseInfo As MAPIFolder
Dim olitem As MailItem

Set nsSession = ThisOutlookSession.Session
Set fldDBADatabaseInfo = nsSession.Folders("Mailbox - Poole, David").Folders("Inbox").Folders("DBADatabaseInfo")


For Each olitem In fldDBADatabaseInfo.Items
If DateDiff("d", olitem.CreationTime, Now) > 2 Then olitem.Delete
Next

Set nsSession = Nothing
Set fldDBADatabaseInfo = Nothing
Set olitem = Nothing

End Sub
--------------------------------------------------

 

[TonyJollans]

Hi David,

Well, it works for me! Not sure what to suggest next. If it runs that implies no errors - in other words it is setting a reference to some folder successfully. Can you single step through it and get any idea of the data it's working with?

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.
Excel VBA Training and more Help at VBAExpress[

 

[dapoole]

Well I am totally confused here as what Gerry mentions above does work to remove emails older than 2 days from my Drafts folder however when I am trying to explicitly mention the path to my folder in my "Inbox" the query runs but does not delete. Grr! What am I doing wrong? Could it be anything to do with the version of my VB, Outlook? Anyone got any other ideas?

Cheers
David

 

[TonyJollans]

Hi David,

It's back to basic debugging techniques - step through the code and see what it is looking at - add msgboxes, debug.prints, whatever, to your code or just use the watch and/or locals windows to look at variables and properties while at a breakpoint. You should be able to see where it's going wrong (even if you can't fix it without more help). Is it finding the right folder? Is it finding the items correctly? Is it picking up the right dates? etc. etc.

I doubt it's to do with the version, but what version of Outlook are you using? And is it on an Exchange Server?

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.
Excel VBA Training and more Help at VBAExpress[

 

[dapoole]

Arrgh! Thanks for your help. This is really annoying me now. :/ Okay the following code CAN see the folder because if I rename the last forlder to say "DBAi" from "DBA" it throws up an error saying it cannot locate the folder. So it must be seeing the folder. I then tried to debug it using the step into and it simply stepped through each stage and looped 2 on the 'For' clause which is expected as there were 2 emails in the folder, however it did not delete them. V v confused. Unfortunately I am not experienced enough to write message boxes, et al.

Public Sub EmptyDBADatabaseInfoEmailFolder()

Dim nsSession As NameSpace
Dim fldDBADatabaseInfo As MAPIFolder
Dim olitem As MailItem

Set nsSession = ThisOutlookSession.Session
Set fldDBADatabaseInfo = nsSession.Folders("Mailbox - Poole, David").Folders("Inbox").Folders("DBA")


For Each olitem In fldDBADatabaseInfo.Items
If DateDiff("d", olitem.CreationTime, Now) > 2 Then olitem.Delete
Next

Set nsSession = Nothing
Set fldDBADatabaseInfo = Nothing
Set olitem = Nothing

End Sub

 

[dapoole]

Just a thought could it be the "creation date" clause:

(i.e. If DateDiff("d", olitem.CreationTime, Now) > 2 Then olitem.Delete)

because I am cutting and pasting emails from another folder? Is it possible to change this to the emails received date?

 

[dapoole]

Yes I have just tested it by changing:

If DateDiff("d", olitem.CreationTime, Now) > 2 Then olitem.Delete

to read:

If DateDiff("d", olitem.ReceivedTime, Now) > 2 Then olitem.Delete


And it works now. Thanks for all the advice.

 

[dapoole]

However can anyone tell me how to put in two conditions such as:

For Each olitem In fldDBA.Items
If DateDiff("d", olitem.ReceivedTime, Now) > 1 Then olitem.Delete
ElseIf DateDiff("d", olitem.CreationTime, Now) > 1 Then olitem.Delete
Next
End If

 

[TonyJollans]

Hi David,

I'm not well up on Outlook Properties but I'm glad you've found the one that does the trick for you.

To make your check against both conditions work, split up the lines a bit and put the endif before the next:

[blue]For Each olitem In fldDBA.Items
    If DateDiff("d", olitem.ReceivedTime, Now) > 1 Then
        olitem.Delete
    ElseIf DateDiff("d", olitem.CreationTime, Now) > 1 Then
        olitem.Delete
    End If
Next[/blue]

alternatively you can combine the conditions:

[blue]For Each olitem In fldDBA.Items
    If DateDiff("d", olitem.ReceivedTime, Now) > 1 _
    Or DateDiff("d", olitem.CreationTime, Now) > 1 Then
        olitem.Delete
    End If
Next[/blue]

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.
Excel VBA Training and more Help at VBAExpress[

 

[dapoole]

Thanks for that, but can I just ask you a quick question? Does
If DateDiff("d", olitem.ReceivedTime, Now) > 1 _
mean 'everything that was received older than today'? And by today does that mean every email older than 00:00 hours this morning or the last 24 hour period since the macro was run?

Cheers
David

 

[TonyJollans]

Hi David,

Both ReceivedTime and Now are accurate to some fraction of a second and the DateDiff Function compares the two, so the check is only satisfied if there is a full 24 hours between them, meaning 'everything received more than 24 hours ago'

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.
Excel VBA Training and more Help at VBAExpress[

 

[dapoole]

Thanks. Have another star!

 

[PHV]

Tony, I must disagree:
? DateDiff("d", #2005-03-22 23:59:00#, #2005-03-23 00:00:00#)
1
David, you may use this instead:
If DateDiff("h", olitem.ReceivedTime, Now) > 24

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[TonyJollans]

You are right, PH, I should have looked more closely. DateDiff is useful in some circumstances but I tend to forget its limitations.

It would probably be easier just to subtract the times rather than using DateDiff:

[blue]For Each olitem In fldDBA.Items
    If (Now - olitem.ReceivedTime) > 1 _
    Or (Now - olitem.CreationTime) > 1 Then
        olitem.Delete
    End If
Next[/blue]

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.
Excel VBA Training and more Help at VBAExpress[