Option Explicit Sub MoveItems() Dim myInbox As Outlook.folder Dim mySubfolder As Outlook.folder Dim myItems As Outlook.Items Dim myItem As Outlook.MailItem Dim olkstore As Outlook.Store Dim olkRoot As Outlook.folder For Each olkstore In Outlook.Session.Stores If olkstore.DisplayName = "davidtallett29@gmail.com" Then Set olkRoot = olkstore.GetRootFolder End If Next Set myInbox = olkRoot.folders.Item("Inbox") Set myItems = myInbox.Items Set mySubfolder = myInbox.folders("Newsletters") ' Set myItem = myItems.Find("[SenderName] = 'Royal Mail'") Set myItem = myItems.Find("[SenderEmailAddress] = 'agea@noticias.clarin.com'") While TypeName(myItem) <> "Nothing" myItem.Move mySubfolder Set myItem = myItems.FindNext Wend End Sub |