V
vbaNEWBIE
Hopefully someone here can help....I would like to move items from my inbox
based on a specific situation. I have the code below for part of it but I
need to add more code to complete it. I am using Outlook 2007 and the code
will run from a Module when initiated by the User.
I would like to move items if meets ALL three conditions:
(1) comes from the Sendername coded below - AND -
(2) the email has been READ - AND -
(3) and the sent date is 14 days old or older
Can anyone help me understand how to modify the code below to accomplish
this ?
Sub MoveItems_Inbox()
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(olFolderInbox)
Set myItems = myInbox.Items
Set myDestFolder =
Outlook.Session.Folders("PersonalFolder").Folders("PersonNameFolder")
Set myItem = myItems.Find("[SenderName] = 'PersonName'")
While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems.FindNext
Wend
End Sub
based on a specific situation. I have the code below for part of it but I
need to add more code to complete it. I am using Outlook 2007 and the code
will run from a Module when initiated by the User.
I would like to move items if meets ALL three conditions:
(1) comes from the Sendername coded below - AND -
(2) the email has been READ - AND -
(3) and the sent date is 14 days old or older
Can anyone help me understand how to modify the code below to accomplish
this ?
Sub MoveItems_Inbox()
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(olFolderInbox)
Set myItems = myInbox.Items
Set myDestFolder =
Outlook.Session.Folders("PersonalFolder").Folders("PersonNameFolder")
Set myItem = myItems.Find("[SenderName] = 'PersonName'")
While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems.FindNext
Wend
End Sub