HOW CAN I CHANGE THIS TO SENT ITEMS

SiSept

New Member
Outlook version
Outlook 2007
Email Account
Exchange Server
#1
How can I change this to run on sent items?

Sub Test()

Dim ns As Outlook.NameSpace
Dim objItem As Object
Dim FolderInbox As Folder
Dim MyItem As Outlook.MailItem

'// Added - A collection to hold the IDs of message to be deleted
Dim cMAILS As Collection

Set ns = Application.GetNamespace("MAPI")
Set FolderInbox = ns.GetDefaultFolder(olFolderInbox)
Set cMAILS = New Collection

For Each objItem In FolderInbox.Items

'// You need one block for each category...
If InStr(objItem.Categories, "SMT AGENDA") > 0 Then
Set MyItem = objItem.Copy
MyItem.Move FolderInbox.Folders("AGENDAS 01 SMT")
cMAILS.Add objItem.EntryID

ElseIf InStr(objItem.Categories, "SMT TEAM LEADERS") > 0 Then
Set MyItem = objItem.Copy
MyItem.Move FolderInbox.Folders("AGENDAS 02 TEAM LEADERS MEETING")
cMAILS.Add objItem.EntryID

ElseIf InStr(objItem.Categories, "COMMUNICATION") > 0 Then
Set MyItem = objItem.Copy
MyItem.Move FolderInbox.Folders("AGENDAS 03 COMMUNICATION MEETING")
cMAILS.Add objItem.EntryID

ElseIf InStr(objItem.Categories, "CAROL MAITLAND") > 0 Then
Set MyItem = objItem.Copy
MyItem.Move FolderInbox.Folders("AGENDAS 04 CAROL MAITLAND")
cMAILS.Add objItem.EntryID

ElseIf InStr(objItem.Categories, "MANAGEMENT") > 0 Then
Set MyItem = objItem.Copy
MyItem.Move FolderInbox.Folders("AGENDAS 05 MANAGEMENT")
cMAILS.Add objItem.EntryID

ElseIf InStr(objItem.Categories, "ADP SUPPORT TEAM") > 0 Then
Set MyItem = objItem.Copy
MyItem.Move FolderInbox.Folders("PROJECTS 01 ADP")
cMAILS.Add objItem.EntryID

ElseIf InStr(objItem.Categories, "BBV") > 0 Then
Set MyItem = objItem.Copy
MyItem.Move FolderInbox.Folders("PROJECTS 02 BBV")
cMAILS.Add objItem.EntryID

ElseIf InStr(objItem.Categories, "CHILDRENS SERVICES") > 0 Then
Set MyItem = objItem.Copy
MyItem.Move FolderInbox.Folders("PROJECTS 03 CPC CHILDRENS SERVICES")
cMAILS.Add objItem.EntryID

ElseIf InStr(objItem.Categories, "D&I") > 0 Then
Set MyItem = objItem.Copy
MyItem.Move FolderInbox.Folders("PROJECTS 04 D&I")
cMAILS.Add objItem.EntryID

ElseIf InStr(objItem.Categories, "EARLIER INTERVENTION") > 0 Then
Set MyItem = objItem.Copy
MyItem.Move FolderInbox.Folders("PROJECTS 05 DIRECT ACCESS")
cMAILS.Add objItem.EntryID

ElseIf InStr(objItem.Categories, "FINANCE") > 0 Then
Set MyItem = objItem.Copy
MyItem.Move FolderInbox.Folders("PROJECTS 06 FINANCE")
cMAILS.Add objItem.EntryID

ElseIf InStr(objItem.Categories, "IAS") > 0 Then
Set MyItem = objItem.Copy
MyItem.Move FolderInbox.Folders("PROJECTS 07 IAS REDESIGN")
cMAILS.Add objItem.EntryID

ElseIf InStr(objItem.Categories, "KEEPWELL") > 0 Then
Set MyItem = objItem.Copy
MyItem.Move FolderInbox.Folders("PROJECTS 08 KEEPWELL")
cMAILS.Add objItem.EntryID

ElseIf InStr(objItem.Categories, "KEY PRIORITY") > 0 Then
Set MyItem = objItem.Copy
MyItem.Move FolderInbox.Folders("PROJECTS 09 KEY AIM AND NALOXONE")
cMAILS.Add objItem.EntryID

ElseIf InStr(objItem.Categories, "MARYWELL") > 0 Then
Set MyItem = objItem.Copy
MyItem.Move FolderInbox.Folders("PROJECTS 10 MARYWELL")
cMAILS.Add objItem.EntryID

ElseIf InStr(objItem.Categories, "PFR") > 0 Then
Set MyItem = objItem.Copy
MyItem.Move FolderInbox.Folders("PROJECTS 11 PFR")
cMAILS.Add objItem.EntryID

ElseIf InStr(objItem.Categories, "QUALITY FRAMEWORK") > 0 Then
Set MyItem = objItem.Copy
MyItem.Move FolderInbox.Folders("PROJECTS 12 QUALITY FRAMEWORK")
cMAILS.Add objItem.EntryID

ElseIf InStr(objItem.Categories, "RECOVERY") > 0 Then
Set MyItem = objItem.Copy
MyItem.Move FolderInbox.Folders("PROJECTS 13 RECOVERY")
cMAILS.Add objItem.EntryID

End If
Next
On Error Resume Next

Do While cMAILS.count > 0

Set MyItem = ns.GetItemFromID(cMAILS(1))

If Not MyItem Is Nothing Then
MyItem.Delete
End If

cMAILS.Remove (1)
Loop

End Sub
 

SiSept

New Member
Outlook version
Outlook 2007
Email Account
Exchange Server
#4
This : Set FolderInbox = ns.GetDefaultFolder(olFolderInbox) needs changed to use olFolderSentItems
Thank you for replying asI am sure you are very busy. (sorry for the CAPS in the Heading - nothing meant by them!) I tried your suggested change and it wont work - the debug just highlights this line. I have no VBA knowledge!
[DOUBLEPOST=1443532347][/DOUBLEPOST]
See the GetDefaultFolder function, there change the passed value to olFolderSentItems.
Thank you for replying as I am sure you are very busy. (sorry for the CAPS in the Heading - nothing meant by them!) I tried your suggested change and it wont work - the debug just highlights this line. I have no VBA knowledge!
 
Top