Deleting oldest message in inbox using VBA

[Reg123456]

Hi guys. I am using outlook 2007 and I need to write some code where the oldest message in my inbox is deleted automatically after a threshold of 1000 messages. So once my inbox has 1000 messages, and 5 new messages arrive, the oldest 5 messages must be deleted. I have gone all over the place to find a solution, and I'm starting to think there isn't one.

The code I have so far deletes every message after 1000, but I can't get it to delete the oldest messages even though I use 'GetLast.Delete' :banghead:

Private Sub Application_Quit()

Set objOutlook = New Outlook.Application
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objMessages = objNameSpace.Folders.Item("Personal Folders").Folders.Item("Deleted Items").Items

If objMessages.Count > 1000 Then

ToDelete = objMessages.Count - 1000
i = 0
Do
i = i + 1
CurCount = objMessages.Count
objMessages.GetLast.Delete
Set objMessages = objNameSpace.Folders.Item("Personal Folders").Folders.Item("Deleted Items").Items ' if I don't reuse this line of code, I get an out of array error.
Loop Until i > ToDelete
End If

End Sub

Does anyone have an idea how to tweak this code so it only deletes the oldest entries in the list?

Much Appreciated.

[TonyJollans]

You need to sort the items ..


' ...
Set objMessages = objNameSpace.Folders.Item("Personal Folders").Folders.Item("Deleted Items").Items
objMessages.Sort "[Received]", True
If objMessages.Count > 1000 Then
' etc.
' ...

[Reg123456]

Thank you very much.