Outlook VBA Code - Delete Items in toggle folder and subfolder

Physimed
Physimed used Ask the Experts™
on
I found that script in Expert Exchange

http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_27730495.html

It's a great script

I'm looking someting like that but with one step further

is it possible to delete every item in folder and its subfolder

ex:
\\pstname\Inbox\Fred\[ALL]subFolder

assuming that there are a lot of subs and they can possibly change

so I want the script able to look all sub folders in a dynamical way
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
View Solution Only
Qlemo"Batchelor", Developer and EE Topic Advisor
Top Expert 2015

Commented:
That's a bit more complex, as we have to implement a recursive procedure for that. You'll call the changed sub DeleteOlderThan1day again:
Sub DeleteOlderThan1day()
  Call DeleteOlderInSub(Application.Session.Folder("pstname").Folders("Inbox").Folders("Fred"), DateAdd("d", -1, Now())
End Sub

Sub DeleteOlderInSub(oFolder as Folder, oldDate as Date)
Dim oSubfolder as Folder
Dim ItemsOverMonths As Outlook.Items

  Set ItemsOverMonths = oFolder.Items.Restrict("[Received] <= """ & Format(oldDAte, "mm/dd/yyyy") & """")
  For i = ItemsOverMonths.Count To 1 Step -1
    ItemsOverMonths.Item(i).Delete
  Next

  For Each oSubFolder In oFolder.Folders
    DeleteOlderInSub(oSubFolder, oldDate)
  Next

  Set ItemsOverMonths = Nothing
End Sub

Open in new window

Physimed

Author

Commented:
I have a compilation error on thoses lines

Call DeleteOlderInSub(Application.Session.Folder("pstname").Folders("Inbox").Folders("Fred"), DateAdd("d", -1, Now())


DeleteOlderInSub(oSubFolder, oldDate)
"Batchelor", Developer and EE Topic Advisor
Top Expert 2015
Commented:
Sorry.
Sub DeleteOlderThan1day()
  DeleteOlderInSub Application.Session.Folder("pstname").Folders("Inbox").Folders("Fred"), DateAdd("d", -1, Now())
End Sub

Sub DeleteOlderInSub(oFolder As Folder, oldDate As Date)
Dim oSubfolder As Folder
Dim ItemsOverMonths As Outlook.Items

  Set ItemsOverMonths = oFolder.Items.Restrict("[Received] <= """ & Format(oldDate, "mm/dd/yyyy") & """")
  For i = ItemsOverMonths.Count To 1 Step -1
    ItemsOverMonths.Item(i).Delete
  Next

  For Each oSubfolder In oFolder.Folders
    DeleteOlderInSub oSubfolder, oldDate
  Next

  Set ItemsOverMonths = Nothing
End Sub

Open in new window

Physimed

Author

Commented:
This is what I was expected

Thank you very much for your help

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial