Move old emails or emails with large attachments ?

  • Thread starter Thread starter vbaNEWBIE
  • Start date Start date
V

vbaNEWBIE

Hello !
I need help in figuring out how to edit the code below (which works) to move
SENT items to a separate personal folder called out here. I want to move
emails that were sent 90 days ago or older to the personal folder. I also
want to move emails that contain attachments that have a size greater than 5
MB. This code will run when called by the user from a Module.

I have not figured out yet how to code an IF statement for Outlook yet much
less one that requires an OR operator as well.

I am using Outlook 2007. Can anyone provide direction for me in this ?

thanks !


Code follows:

Sub MoveItems_Old_and_Large()
Dim myOlApp As New Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.MAPIFolder
Dim myDestFolder As Outlook.MAPIFolder
Dim myItems As Outlook.Items
Dim myItem As Object
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderSent)
Set myItems = myInbox.Items
' Set myDestFolder = myInbox.Folders("Personal Mail")
Set myDestFolder =
Outlook.Session.Folders("OldSentItems").Folders("Year2010")

While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems.FindNext
Wend
End Sub
 
After further review and analysis, I think I have the code working that will
move Sent emails that are large to a different folder. This comes in handy
when a user is limited in their space and wants to clear out their Sent Items
that are over a certain size. I am posting that code below in case it helps
anyone in the future.

I have looked into the Date issue and need some help with it due to
formatting being required of the date to work with Outlook dates.

Can anyone help with that portion ?



Sub MoveItems_Large()
Dim myOlApp As New Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.MAPIFolder
Dim myDestFolder As Outlook.MAPIFolder
Dim myItems As Outlook.Items
Dim myItem As Object
Set myNameSpace = myOlApp.GetNamespace("MAPI")
' Not sure if the Sent Folder uses the name olFolderSentMail for all systems
' but this works on my machine :-)
Set myInbox = myNameSpace.GetDefaultFolder(olFolderSentMail)
Set myItems = myInbox.Items
Set myDestFolder =
Outlook.Session.Folders("OldSentItems").Folders("Year2010")

' Moves emails with a size of approx 6 MB
' Use 3200000 for 3 MB
' Use 1048576 for 1 MB
Set myItem = myItems.Find("[Size] > '6000000'")

While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems.FindNext
Wend
End Sub
 
Back
Top