Excel VBA to move emails to subfolder in New Outlook


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