Macro to automate clearing down Outlook items and subfolders

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?

Is Outlook running when you run this code?

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

with:
Set olkApp = CreateObject("Outlook.Application")

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

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

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

Thanks, I will try to get back into the training room again today to try this; otherwise it will have to be tomorrow.

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

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.

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

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

That should do it!

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

Sorry, left an extra (unnecessary) line in the first script...

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.

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

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.

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

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.

Oops, sorry... not sure why that got posted again... ignore above comment!!

Thanks pp.  I'll give this a try tomorrow, when I am next in the training room.  Hope this is it!

Linda

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

Linda