Solved: Macro to delete certain types of Items

[Paul_Hossler]

Can someone post a macro (to get me started) that will 'sweep' all OL folders and delete certain types of Items (Read Receipts, Meeting Acceptances, and the like)?

They tend to pile up (esp in Deleted), and I was looking for an easy quick painless way to purge those types, but leave the messages, etc. Even tho the message is deleted, I'm not ready to really delete it

Thanks

Paul

[JP2112]

I have one technique here: Delete Expired Items

But it needs some heavy adaptation to do what you want. There are some recursion examples here:

http://support.microsoft.com/?kbid=294457
http://blogs.technet.com/heyscriptin...ook-inbox.aspx

[Paul_Hossler]

Thanks - the links helped

This is what I ended up with.

It seems to work .. so far


[vba]
Option Explicit
Const cTITLE As String = "Delete Junk-type items (Read Receipts, Meeting Acceptances, etc.)"

Sub DeleteSomeItems()

Dim olFldr As Outlook.MAPIFolder, olFldr2 As Outlook.MAPIFolder


'ask user if this isreally what they want to do
If MsgBox("This will delete the junk type of items in Inbox and DeletedItems and one level of sub-folders", _
vbQuestion + vbOKCancel + vbDefaultButton1, cTITLE) = vbCancel Then Exit Sub



' get default Inbox items collection
Set olFldr = GetDefaultFolder(olFolderInbox)

'do the Inbox
Call DeleteItemsInFolder(olFldr, olFolderInbox)

'and each subfolder. Only go down 2 levels
For Each olFldr2 In olFldr.Folders
Call DeleteItemsInFolder(olFldr2, olFolderInbox)
Next olFldr2


' get default DeletedItems collection
Set olFldr = GetDefaultFolder(olFolderDeletedItems)

'do the Inbox
Call DeleteItemsInFolder(olFldr, olFolderDeletedItems)

'and each subfolder. Only go down 2 levels
For Each olFldr2 In olFldr.Folders
Call DeleteItemsInFolder(olFldr2, olFolderDeletedItems)
Next olFldr2


'we're done
Call MsgBox("Finished deleting the junk items", vbInformation + vbOKOnly, cTITLE)

End Sub

Sub DeleteItemsInFolder(olFolder As Outlook.MAPIFolder, Foldertype As Outlook.OlDefaultFolders)

Dim olItems As Outlook.Items
Dim olMessage As Object
Dim i As Long

For i = olFolder.Items.Count To 1 Step -1
Select Case TypeName(olFolder.Items(i))
Case "MeetingItem"
Call olFolder.Items(i).Delete

Case "ReportItem"
Call olFolder.Items(i).Delete

Case "MailItem"
If Left(olFolder.Items(i).Subject, Len("out of office:")) = "Out of Office:" Then
Call olMessage.Delete
ElseIf Left(olFolder.Items(i).Subject, Len("read:")) = "Read:" Then
Call olFolder.Items(i).Delete
ElseIf Left(olFolder.Items(i).Subject, Len("not read:")) = "Not read:" Then
Call olFolder.Items(i).Delete
End If

Case "AppointmentItem"
If Foldertype = olFolderDeletedItems Then olFolder.Items(i).Delete

Case "SharingItem"
If Foldertype = olFolderDeletedItems Then olFolder.Items(i).Delete

Case "MeetingItem"
If Foldertype = olFolderDeletedItems Then olFolder.Items(i).Delete


End Select
Next i
End Sub

' returns MAPIFolder object from default folder list to calling program
Private Function GetDefaultFolder(outlookFolder As OlDefaultFolders) As Outlook.MAPIFolder
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")

Set GetDefaultFolder = olNS.GetDefaultFolder(outlookFolder)
End Function

[/vba]


Paul