Deleting emails from a list of senders vs. just one ...

[JonnyAMP]

I apologize if this has been posted but my searches didn't find anything.

I have a macro that deletes all emails in a folder from a particular sender. In order to delete from multiple senders I end up copying the same few lines as I can't figure out how to loop with a list. Thanks in advance.



Sub ResearchPurge_From_Trash()
Dim myNameSpace As Outlook.NameSpace
Dim myDelItemsBox As Outlook.Folder
Dim myItems As Outlook.Items
Dim myItem As Object


Set myNameSpace = Application.GetNamespace("MAPI")
Set myDelItemsBox = myNameSpace.GetDefaultFolder(olFolderDeletedItems)

Set myItems = myDelItemsBox.Items


Set myItem = myItems.Find("[SenderEmailAddress] = 'first1.last1....'")
While TypeName(myItem) <> "Nothing"
myItem.Delete
Set myItem = myItems.FindNext
Wend

Set myItem = myItems.Find("[SenderEmailAddress] = 'first2.last2....'")
While TypeName(myItem) <> "Nothing"
myItem.Delete
Set myItem = myItems.FindNext
Wend


Set myItem = myItems.Find("[SenderEmailAddress] = 'first3.last3...'")
While TypeName(myItem) <> "Nothing"
myItem.Delete
Set myItem = myItems.FindNext
Wend




End Sub

[skatonni]

You could loop like this.


Option Explicit

Sub ResearchPurge_From_Trash()
Dim myNameSpace As Namespace
Dim myDelItemsBox As folder

Dim myItems As Items
Dim myItem As Object

Dim i As Long

Const arrsize = 5 ' Adjust as needed
Dim strSearchArray(arrsize) As String

strSearchArray(1) = "email"
strSearchArray(2) = "email"
strSearchArray(3) = "email"
strSearchArray(4) = "email"
strSearchArray(5) = "email"
Set myNameSpace = GetNamespace("MAPI")
Set myDelItemsBox = myNameSpace.GetDefaultFolder(olFolderDeletedItems)

Set myItems = myDelItemsBox.Items

For i = LBound(strSearchArray) To UBound(strSearchArray)
Debug.Print strSearchArray(i)

Set myItem = myItems.Find("[SenderEmailAddress] = """ & strSearchArray(i) & """")
While TypeName(myItem) <> "Nothing"
Debug.Print myItem.Subject
myItem.Delete
Set myItem = myItems.FindNext
Wend
Next

ExitRoutine:
Set myNameSpace = Nothing
Set myDelItemsBox = Nothing
Set myItems = Nothing
Set myItem = Nothing
End Sub