Something wrong but where ???

  • Thread starter Thread starter BARBIERI =?ISO-8859-1?Q?S=E9bastien?=
  • Start date Start date
B

BARBIERI =?ISO-8859-1?Q?S=E9bastien?=

Here is the code
Sub DeleteoldMDSfeed()
Dim myInbox As MAPIFolder
Dim msg As MailItem
Dim myNS As NameSpace
Dim oApp As Application
Dim oMsg As Object

Set oApp = New Outlook.Application
Set myNS = oApp.GetNamespace("MAPI")

Set myInbox = myNS.GetDefaultFolder(olFolderInbox)
Dim ToBeDeleted() As MailItem
For Each folder1 In myInbox.Folders
'Debug.Print "In folder:" & folder1.Name
If folder1.Name = "MDS" Then
For Each folder2 In folder1.Folders
'Debug.Print ">>>In folder:" & folder2.Name
For Each msg In folder2.Items
'Debug.Print "DateDiff " & DateDiff("d",
msg.ReceivedTime, Now)
If DateDiff("d", msg.ReceivedTime, Now) > 1 Then
Debug.Print "should delete" & DateDiff("d",
msg.ReceivedTime, Now)
msg.Delete

'msg.Move
(myNS.GetDefaultFolder(olFolderDeletedItems))
End If
Next
Next
End If
Next
End Sub

The goal is to purge all message that are older than 1 day in a specified
folders and subfolders (here the folder is MDS and I've to remove messages
from all subfolders).

I tried with msg.Move but this doesn't work anymore since I restarted my
computer (I have no f**k**g idea why ?).
It works with msg.Delete but it doesn't works as I expected.
with the msg.Delete message with more than 1 day are deleted but only few of
them. (I receive about 1000 of message a day, perhaps it's because of the
amount of message).
Well if somone have an idea to remove message older than 1 day in a specific
folder... It could be cool to share it with me.

Something else...
How do I automatically launch a vba script every day or every nigth
(better). (The one above for example).

Thanks.
 
Back
Top