[OUTLOOK] Remove Email on secondary mailbox

[Corentin]

Hello,

I'm trying to automatize the deletion of secondary mailboxes items that are older than 6 days. The problem is that the objFolder and the SI_Items variables didn't initialize correctly in the script below. This script works perfectly if I change it a little bit in order to launch it in my own mailbox.

Can you please help me to find a solution ?

Sub RemoveOldEmails()

Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim SI_Items As Outlook.MailItem
Dim objFolder As Outlook.Folder
Dim myRecipient As Outlook.Recipient

On Error Resume Next

Set objOL = CreateObject("outlook.application")
Set objNS = objOL.GetNamespace("MAPI")

Set myRecipient = objNS.CreateRecipient("TEST-AUD")
myRecipient.Resolve

Set objFolder = objNS.GetSharedDefaultFolder(myRecipient, olFolderInbox)
Set SI_Items = objFolder.Items


For i = SI_Items.Count To 1 Step -1
If TypeName(SI_Items.Item(i)) = "MailItem" Then
If Date - SI_Items.Item(i).ReceivedTime > 6 Then SI_Items.Item(i).Delete
End If
Next

Set olApp = Nothing
Set objNS = Nothing
Set objFolder = Nothing
Set SI_Items = Nothing
Set myRecipient = Nothing
End Sub


Many thanks in advance for your help,

Best regards,

Corentin

[Corentin]

Solution found :


Sub RemoveOldEmails()

Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim SI_Items As Outlook.MAPIFolder
Dim myRecipient As Outlook.Recipient
Dim myFolders As Outlook.Folders
Dim myFolder As Outlook.Folder
Dim mailItem As Outlook.Items


On Error Resume Next

Set objOL = CreateObject("outlook.application")
Set objNS = objOL.GetNamespace("MAPI")
Set myFolders = objNS.Folders


Set myRecipient = objNS.CreateRecipient("TEST-AUD")
myRecipient.Resolve

For Each myFolder In myFolders
If myFolder.Name = myRecipient Then
For j = 1 To myFolder.Folders.Count
If myFolder.Folders(j).Name = "Inbox" Then
Set SI_Items = myFolder.Folders(j)
Set mailItem = SI_Items.Items
For i = mailItem.Count To 1 Step -1
If TypeName(mailItem.Item(i)) = "MailItem" Then
If Date - mailItem(i).ReceivedTime > 6 Then mailItem(i).Delete
End If
Next
End If
Next
End If
Next


Set objOL = Nothing
Set objNS = Nothing
Set myFolder = Nothing
Set myFolders = Nothing
Set SI_Items = Nothing
Set myRecipient = Nothing
End Sub