CODEWITHSUNDEEP
vbaoutlook
HGtez
HGtez

Reputation: 89

How to delete emails from a string of users?

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

Upvotes: 1

Views: 507

Answers (2)

niton
niton

Reputation: 9179

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

Upvotes: 1

0m3r
0m3r

Reputation: 12499

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

Upvotes: 1

Related Questions