How to delete emails from a string of users? - vba

Question

How can I go through this "indefinite 5-10..." list of senders and delete their messages:
mySenders =" Dan Wilson, Tom Hanks, Alisa Milano, Jessica Alba, Torrid, Captain America"
The code below works for a single sender.
Sub MoveItems()
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Dim myItems As Outlook.Items
Dim myItem As Object
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myItems = myInbox.Items
Set myDestFolder = myNameSpace.GetDefaultFolder(olFolderDeletedItems)
'how to loop here?
Set myItem = myItems.Find("[SenderName] = 'Kmart'")
While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems.FindNext
Wend
End Sub

Answer 1

little confuse. but to delete msg from multiple sender, Add a Second While .. Wend and modify it to use myItem.Delete
Example:
Tested on Outlook 2010
Option Explicit
Sub DeleteItems()
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myItems As Outlook.Items
Dim myItem As Object
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myItems = myInbox.Items
'// loop for each sender
Set myItem = myItems.Find("[SenderName] = 'Dan Wilson'")
While TypeName(myItem) <> "Nothing"
myItem.Delete
Set myItem = myItems.FindNext
Wend
'// Loop Next Sender
Set myItem = myItems.Find("[SenderName] = 'Tom Hanks'")
While TypeName(myItem) <> "Nothing"
myItem.Delete
Set myItem = myItems.FindNext
Wend
Set myItem = myItems.Find("[SenderName] = 'Alisa Milano'")
While TypeName(myItem) <> "Nothing"
myItem.Delete
Set myItem = myItems.FindNext
Wend
' More here
End Sub

Answer 2

You could loop through an an array based on mySenders.
Option Explicit
Sub MoveItems()
Dim myNameSpace As Namespace
Dim myInbox As folder
Dim myDestFolder As folder
Dim myItems As Items
Dim myItem As Object
Dim mySenders() As String
Dim i As Long
Set myNameSpace = GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myItems = myInbox.Items
Set myDestFolder = myNameSpace.GetDefaultFolder(olFolderDeletedItems)
mySenders = Split("Dan Wilson,Tom Hanks,Alisa Milano,Jessica Alba,Torrid,Captain America", ",")
For i = LBound(mySenders) To UBound(mySenders)
Debug.Print i & " - " & mySenders(i)
Set myItem = myItems.Find("[SenderName] = """ & mySenders(i) & """")
While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems.FindNext
Wend
Next
End Sub
You will need the exact names.
Sub display_SenderName()
Dim currItem As Object
Select Case ActiveWindow.Class
Case olExplorer
' The active window is a list of messages (folder)
' There might be several selected messages
' Here only one is processed
Set currItem = ActiveExplorer.Selection(1)
Debug.Print currItem.Subject
Debug.Print currItem.senderName
Case olInspector
Set currItem = ActiveInspector.currentItem
Debug.Print currItem.Subject
Debug.Print currItem.senderName
End Select
End Sub