Outlook VBA Code - Delete Items in toggle folder and subfolder

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

PhysimedAsked: 2015-10-23

Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

Experts Exchange Solution brought to you by

Enjoy your complimentary solution view.

Get every solution instantly with Premium. Start your 7-day free trial.

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

LVL 74

Qlemo"Batchelor", Developer and EE Topic AdvisorCommented: 2015-10-25

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

PhysimedAuthor Commented: 2015-10-26

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)

LVL 74

Qlemo"Batchelor", Developer and EE Topic AdvisorCommented: 2015-10-26

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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial