Macro to automate clearing down Outlook items and subfolders

I accepted a VB code solution to an earlier question:
http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_22782345.html

Here is the code in its entirety:

ResetOutlook
WScript.Echo "Outlook has been reset on this computer."
WScript.Quit

Sub ResetOutlook()
    Const olFolderInbox = 6
    Const olFolderDeletedItems = 3
    Dim olkApp, olkRootFolder, intFolders
    Set olkApp = GetObject(, "Outlook.Application")
    Set olkRootFolder = olkApp.Session.GetDefaultFolder(olFolderInbox).Parent
    For intFolders = olkRootFolder.Folders.Count To 1 Step -1
        ClearFolder olkRootFolder.Folders.Item(intFolders)
    Next
    'Empty Deleted Items now that we're all done
    ClearFolder olkApp.Session.GetDefaultFolder(olFolderDeletedItems)
    Set olkRootFolder = Nothing
    Set olkApp = Nothing
End Sub

Sub ClearFolder(olkFolder As Outlook.MAPIFolder)
    Dim intIndex
    Select Case olkFolder.Name
        'If it's one of Outlook's default folders, thenw e clean it up.
        Case "Calendar", "Contacts", "Drafts", "Deleted Items", "Inbox", "Journal", "Junk E-mail", "Notes", "Outbox", "Sent Items", "Tasks"
            'Delete the items
            For intIndex = olkFolder.Items.Count To 1 Step -1
                olkFolder.Items.Item(intIndex).Delete
            Next
            'Delete the sub-folders
            For intIndex = olkFolder.Folders.Count To 1 Step -1
                olkFolder.Folders.Item(intIndex).Delete
            Next
        'If it's not a default folder, then delete it and all it's contents
        Case Else
            olkFolder.Delete
    End Select
End Sub

Although the code looked exactly what I needed,  I didn't test it because, in the meantime, an alternative solution had been developed by another team within my organisation.  Unfortunately, I have now found that their 'in-house' solution actually doesn't do the job properly and I need to use the VB solution given.

However, I have tried running the code but it fails with a VBScript compilation error, which I don't have the knowledge to fix. The error reported is:

Line: 20
Char: 27
Error: Expected ')'
Code: 800A03EE

Can anyone help with this please?

Thanks
Linda

LindaWestonAsked:
Who is Participating?
 
purplepomegraniteCommented:
ResetOutlook

dim WshShell
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run """C:\Program Files\Microsoft Office\OFFICE11\OUTLOOK.EXE"" /firstrun /cleanprofile /cleanrules /cleanviews /cleanfinders /cleanreminders /resetfolders /resetfoldernames /resetnavpane /nopreview"
set WshShell = Nothing

WScript.Echo "Outlook has been reset on this computer."
WScript.Quit

Sub ResetOutlook()
      Const olFolderInbox = 6
      Const olFolderDeletedItems = 3
      Dim olkApp, olkRootFolder, intFolders
           
      Set olkApp = CreateObject("Outlook.Application")
      Set olkRootFolder = olkApp.Session.GetDefaultFolder(olFolderInbox).Parent
      For intFolders = olkRootFolder.Folders.Count To 1 Step -1
            ClearFolder olkRootFolder.Folders.Item(intFolders)
      Next
      'Empty Deleted Items now that we're all done
      ClearFolder olkApp.Session.GetDefaultFolder(olFolderDeletedItems)
      Set olkRootFolder = Nothing
            olkApp.Quit ' Need to quit Outlook to run shell command - should quit anyway as we created it!
      Set olkApp = Nothing
End Sub

Sub ClearFolder(olkFolder)
      Dim intIndex
      Select Case olkFolder.Name
            'If it's one of Outlook's default folders, thenw e clean it up.
            Case "Calendar", "Contacts", "Drafts", "Deleted Items", "Inbox", "Journal", "Junk E-mail", "Notes", "Outbox", "Sent Items", "Tasks"
                  'Delete the items
                  For intIndex = olkFolder.Items.Count To 1 Step -1
                        olkFolder.Items.Item(intIndex).Delete
                  Next
                  'Delete the sub-folders
                  For intIndex = olkFolder.Folders.Count To 1 Step -1
                        olkFolder.Folders.Item(intIndex).Delete
                  Next
                 
            'If it's not a default folder, then delete it and all it's contents
            Case Else
                  on error resume next
                  olkFolder.Delete
                  if Err.Number<>0 then
                        ' Couldn't delete this folder
                        wscript.echo "Couldn't delete folder: " & olkFolder.Name
                        Err.Clear
                  end if
                  on error goto 0
      End Select
End Sub
0
 
LindaWestonAuthor Commented:
I made the following change to the code as suggested:

Sub ClearFolder(olkFolder)
rather then Sub ClearFolder(olkFolder As Outlook.MAPIFolder)

However, still got runtime error as follows:
Line: 9
Char: 5
Errror: ActiveX component can't create object: 'GetObject'
Code: 800A01AD


Any ideas please?
0
 
purplepomegraniteCommented:
Is Outlook running when you run this code?

If it isn't, replace:
Set olkApp = GetObject(, "Outlook.Application")

with:
Set olkApp = CreateObject("Outlook.Application")
0
Cloud Class® Course: Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

 
LindaWestonAuthor Commented:
Thanks very much, pp. No, Outlook is not running at the time.  I will try this in the training room asap and post my findings.

Linda
0
 
LindaWestonAuthor Commented:
Hi pp,
I have tried this as suggested.  It opens Outlook fine, but then I get the following error:

Line: 35
Char: 13
Errror: Unable to delete this folder.  Right-clickthe folder, and then click Properties to check your permissions for the folder.  see the folder owner or your administrator to change your permissions.

Code: 80020009

Here is the latest version of the code I am running:
ResetOutlook
WScript.Echo "Outlook has been reset on this computer."
WScript.Quit

Sub ResetOutlook()
    Const olFolderInbox = 6
    Const olFolderDeletedItems = 3
    Dim olkApp, olkRootFolder, intFolders
    Set olkApp = CreateObject("Outlook.Application")
    Set olkRootFolder = olkApp.Session.GetDefaultFolder(olFolderInbox).Parent
    For intFolders = olkRootFolder.Folders.Count To 1 Step -1
        ClearFolder olkRootFolder.Folders.Item(intFolders)
    Next
    'Empty Deleted Items now that we're all done
    ClearFolder olkApp.Session.GetDefaultFolder(olFolderDeletedItems)
    Set olkRootFolder = Nothing
    Set olkApp = Nothing
End Sub

Sub ClearFolder(olkFolder)
    Dim intIndex
    Select Case olkFolder.Name
        'If it's one of Outlook's default folders, thenw e clean it up.
        Case "Calendar", "Contacts", "Drafts", "Deleted Items", "Inbox", "Journal", "Junk E-mail", "Notes", "Outbox", "Sent Items", "Tasks"
            'Delete the items
            For intIndex = olkFolder.Items.Count To 1 Step -1
                olkFolder.Items.Item(intIndex).Delete
            Next
            'Delete the sub-folders
            For intIndex = olkFolder.Folders.Count To 1 Step -1
                olkFolder.Folders.Item(intIndex).Delete
            Next
        'If it's not a default folder, then delete it and all it's contents
        Case Else
            olkFolder.Delete
    End Select
End Sub


I am logged on as a student, whose permissions are no doubt pretty restricted.  However, I only want to delete folders created by that student during their session in Outlook, so I cannot see why they can't delete folders they created.

Hope you can shed some light on this?

Cheers
Linda
0
 
purplepomegraniteCommented:
This is a permissions error, which implies that the code is now working.

Can you check the permissions for the folder?

To find out the specific folder causing the problem, change your code as such:

ResetOutlook
WScript.Echo "Outlook has been reset on this computer."
WScript.Quit

Sub ResetOutlook()
      Const olFolderInbox = 6
      Const olFolderDeletedItems = 3
      Dim olkApp, olkRootFolder, intFolders
      Set olkApp = CreateObject("Outlook.Application")
      Set olkRootFolder = olkApp.Session.GetDefaultFolder(olFolderInbox).Parent
      For intFolders = olkRootFolder.Folders.Count To 1 Step -1
            ClearFolder olkRootFolder.Folders.Item(intFolders)
      Next
      'Empty Deleted Items now that we're all done
      ClearFolder olkApp.Session.GetDefaultFolder(olFolderDeletedItems)
      Set olkRootFolder = Nothing
      Set olkApp = Nothing
End Sub

Sub ClearFolder(olkFolder)
      Dim intIndex
      Select Case olkFolder.Name
            'If it's one of Outlook's default folders, thenw e clean it up.
            Case "Calendar", "Contacts", "Drafts", "Deleted Items", "Inbox", "Journal", "Junk E-mail", "Notes", "Outbox", "Sent Items", "Tasks"
                  'Delete the items
                  For intIndex = olkFolder.Items.Count To 1 Step -1
                        olkFolder.Items.Item(intIndex).Delete
                  Next
                  'Delete the sub-folders
                  For intIndex = olkFolder.Folders.Count To 1 Step -1
                        olkFolder.Folders.Item(intIndex).Delete
                  Next
                  
            'If it's not a default folder, then delete it and all it's contents
            Case Else
                  on error resume next
                  olkFolder.Delete
                  if Err.Number<>0 then
                        ' Couldn't delete this folder
                        wscript.echo "Couldn't delete folder: " & olkFolder.Name
                        Err.Clear
                  end if
                  on error goto 0
      End Select
End Sub
0
 
LindaWestonAuthor Commented:
Thanks, I will try to get back into the training room again today to try this; otherwise it will have to be tomorrow.
0
 
LindaWestonAuthor Commented:
Hi pp,
I have now tested this out and the folder that cannot be deleted is 'Sync Issues'.  However, very pleased to say that everything else works as intended now.

I am not sure how to deal with the Sync Issues folder. Perhaps you can advise?

Also, what I then have to do after this script is run is launch Outlook with a lot of switches that reset things like navigation pane, rules etc.  I have set up a desktop icon that does this, but wonder could the command line be included within the script we are dealing with in this question?  That would be great as it would then be a one-step process to reset Outlook.

Linda
0
 
purplepomegraniteCommented:
If you post the command line for the Outlook reset, I can add it to the code no problem.

The Sync Issues folder is created automatically when there are issues synchronising (though can't remember if this is ActiveSync or server synchronisation issues...).  So the user probably won't have permissions to delete it, you'd need to be an administrator.  Mind you, it will be created again next time there are issues, so I'd be inclined just to leave it there.
0
 
LindaWestonAuthor Commented:
Thank you very much.  Here is the command line:

"C:\Program Files\Microsoft Office\OFFICE11\OUTLOOK.EXE" /firstrun /cleanprofile /cleanrules /cleanviews /cleanfinders /cleanreminders /resetfolders /resetfoldernames /resetnavpane /nopreview

I may not actually need all of these switches, but they seem to work fine and leave Outlook looking as I need it to.

Regarding the Sync Issues folder.  It is ActiveSync.  I will leave it as you suggest.

Linda
0
 
purplepomegraniteCommented:
ResetOutlook

dim WshShell
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "C:\Program Files\Microsoft Office\OFFICE11\OUTLOOK.EXE /firstrun /cleanprofile /cleanrules /cleanviews /cleanfinders /cleanreminders /resetfolders /resetfoldernames /resetnavpane /nopreview"
set WshShell = Nothing

WScript.Echo "Outlook has been reset on this computer."
WScript.Quit

Sub ResetOutlook()
      Const olFolderInbox = 6
      Const olFolderDeletedItems = 3
      Dim olkApp, olkRootFolder, intFolders
            Dim blnOutlookCreated
            
      Set olkApp = CreateObject("Outlook.Application")
      Set olkRootFolder = olkApp.Session.GetDefaultFolder(olFolderInbox).Parent
      For intFolders = olkRootFolder.Folders.Count To 1 Step -1
            ClearFolder olkRootFolder.Folders.Item(intFolders)
      Next
      'Empty Deleted Items now that we're all done
      ClearFolder olkApp.Session.GetDefaultFolder(olFolderDeletedItems)
      Set olkRootFolder = Nothing
            olkApp.Quit ' Need to quit Outlook to run shell command - should quit anyway as we created it!
      Set olkApp = Nothing
End Sub

Sub ClearFolder(olkFolder)
      Dim intIndex
      Select Case olkFolder.Name
            'If it's one of Outlook's default folders, thenw e clean it up.
            Case "Calendar", "Contacts", "Drafts", "Deleted Items", "Inbox", "Journal", "Junk E-mail", "Notes", "Outbox", "Sent Items", "Tasks"
                  'Delete the items
                  For intIndex = olkFolder.Items.Count To 1 Step -1
                        olkFolder.Items.Item(intIndex).Delete
                  Next
                  'Delete the sub-folders
                  For intIndex = olkFolder.Folders.Count To 1 Step -1
                        olkFolder.Folders.Item(intIndex).Delete
                  Next
                 
            'If it's not a default folder, then delete it and all it's contents
            Case Else
                  on error resume next
                  olkFolder.Delete
                  if Err.Number<>0 then
                        ' Couldn't delete this folder
                        wscript.echo "Couldn't delete folder: " & olkFolder.Name
                        Err.Clear
                  end if
                  on error goto 0
      End Select
End Sub
0
 
purplepomegraniteCommented:
That should do it!
0
 
purplepomegraniteCommented:
ResetOutlook

dim WshShell
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "C:\Program Files\Microsoft Office\OFFICE11\OUTLOOK.EXE /firstrun /cleanprofile /cleanrules /cleanviews /cleanfinders /cleanreminders /resetfolders /resetfoldernames /resetnavpane /nopreview"
set WshShell = Nothing

WScript.Echo "Outlook has been reset on this computer."
WScript.Quit

Sub ResetOutlook()
      Const olFolderInbox = 6
      Const olFolderDeletedItems = 3
      Dim olkApp, olkRootFolder, intFolders
            
      Set olkApp = CreateObject("Outlook.Application")
      Set olkRootFolder = olkApp.Session.GetDefaultFolder(olFolderInbox).Parent
      For intFolders = olkRootFolder.Folders.Count To 1 Step -1
            ClearFolder olkRootFolder.Folders.Item(intFolders)
      Next
      'Empty Deleted Items now that we're all done
      ClearFolder olkApp.Session.GetDefaultFolder(olFolderDeletedItems)
      Set olkRootFolder = Nothing
            olkApp.Quit ' Need to quit Outlook to run shell command - should quit anyway as we created it!
      Set olkApp = Nothing
End Sub

Sub ClearFolder(olkFolder)
      Dim intIndex
      Select Case olkFolder.Name
            'If it's one of Outlook's default folders, thenw e clean it up.
            Case "Calendar", "Contacts", "Drafts", "Deleted Items", "Inbox", "Journal", "Junk E-mail", "Notes", "Outbox", "Sent Items", "Tasks"
                  'Delete the items
                  For intIndex = olkFolder.Items.Count To 1 Step -1
                        olkFolder.Items.Item(intIndex).Delete
                  Next
                  'Delete the sub-folders
                  For intIndex = olkFolder.Folders.Count To 1 Step -1
                        olkFolder.Folders.Item(intIndex).Delete
                  Next
                 
            'If it's not a default folder, then delete it and all it's contents
            Case Else
                  on error resume next
                  olkFolder.Delete
                  if Err.Number<>0 then
                        ' Couldn't delete this folder
                        wscript.echo "Couldn't delete folder: " & olkFolder.Name
                        Err.Clear
                  end if
                  on error goto 0
      End Select
End Sub
0
 
purplepomegraniteCommented:
Sorry, left an extra (unnecessary) line in the first script...
0
 
LindaWestonAuthor Commented:
Thanks very much pp.  I will probably not get a chance to try this now before next Wednesday, as I am offsite for a few days and can't get into the training suite.  But will let you know asap how I get on!  Have a good weekend.  Plenty of sunshine and blue skies I hope.
0
 
LindaWestonAuthor Commented:
Hi pp,

Unfortunately Had a problem with this version of code as follows:

Line: 5
Char: 1
Error:  The system cannot find the file specified.
Code: 80070002
Source: (null)

I have checked the pathname and it looks fine to me.

Linda

0
 
purplepomegraniteCommented:
That's odd... If you copy and paste the command from the wshShell.Run line into a Run box, does that work?

i.e.
Start... Run...
C:\Program Files\Microsoft Office\OFFICE11\OUTLOOK.EXE /firstrun /cleanprofile /cleanrules /cleanviews /cleanfinders /cleanreminders /resetfolders /resetfoldernames /resetnavpane /nopreview


It may be something to do with the spaces in the filepath... I will look into this and post back if so.  Won't be until after the weekend though, probably.
0
 
LindaWestonAuthor Commented:
It won't run if entered as given above (objects to spaces in filepath, as you suggest) but does when I add double quotes as follows:

"C:\Program Files\Microsoft Office\OFFICE11\OUTLOOK.EXE" /firstrun /cleanprofile /cleanrules /cleanviews /cleanfinders /cleanreminders /resetfolders /resetfoldernames /resetnavpane /nopreview

So I changed the quotes in the script, but that produced the error:
Type mismatch '[string: "C:\Program Files\Mic"]'
Code: 800A000D

Hope this helps.

Linda
0
 
purplepomegraniteCommented:
That's odd... If you copy and paste the command from the wshShell.Run line into a Run box, does that work?

i.e.
Start... Run...
C:\Program Files\Microsoft Office\OFFICE11\OUTLOOK.EXE /firstrun /cleanprofile /cleanrules /cleanviews /cleanfinders /cleanreminders /resetfolders /resetfoldernames /resetnavpane /nopreview


It may be something to do with the spaces in the filepath (may have to be converted to short name format)... I will look into this and post back if so.  Won't be until after the weekend though, probably.
0
 
purplepomegraniteCommented:
Oops, sorry... not sure why that got posted again... ignore above comment!!
0
 
LindaWestonAuthor Commented:
Thanks pp.  I'll give this a try tomorrow, when I am next in the training room.  Hope this is it!

Linda

0
 
LindaWestonAuthor Commented:
Thanks very much, pp.  All working now exactly as I hoped.  Have a good day!

Linda
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.