Help Revising VBA macro to delete email over different time span

RayB

Member
Outlook version
Outlook 2007
Email Account
POP3
Hello,

I found and modified this vba to permanently delete emails that I have stored in a folder. It works perfectly, however, keeping 1 year of emails is too many.

How should the vba be modified to keep the newest 5000 emails in the folder. It may be better is you set a variable for how many new messages to keep in case it needs to be changed later.

I admit I am a novice in Outlook vba and really don't understand it.

Thank you for your help!

Sub Delete_Over_A_Year()
'---------------------------------------------------------------------------------------
' Procedure : Delete_Old
' Author : OCTU
' Date : 11/01/2015
' Purpose : permanently delete emails
'---------------------------------------------------------------------------------------
'
Dim Dossier As Folder
Dim NS As NameSpace
Set NS = Application.Session
Set Dossier = NS.GetDefaultFolder(olFolderInbox).Parent.Folders("rbatig Auto Deletes")
Dim myItems
madate = DateAdd("yyyy", -1, Date)
Set myItems = Dossier.items.Restrict("[LastModificationTime] < '" & madate & "'")
While myItems.Count > 0
myItems.Remove 1
'Dossier.Items(1).Delete 'garde historique Exchange
Wend

End Sub
 
Top