Large Excel list of various email addresses that need to be deleted from Outlook

[tommyclearyuk]

Hi All,

I have a large list of email addresses in Excel, I need to delete (ideally to the Delete folder) or remove the emails present in the list from my Outlook Inbox.

I've searched the web to see if I can find a vba routine but have been unsuccessful.

I'd appreciate any assistance.

Many thanks,
Tom

FYI: Using Office 365

 

[tommyclearyuk]

Hi Domenic,

Yes I did populate the Outlook Library in addition despite the screen shot not displaying this so I think we are ok on that note?

Am I right in assuming no alterations need to be made to the code by myself as long as your initial 3 conditions/assumptions are adhered to?

This is the code I've just copied from the compiler:



Option Explicit

Sub MoveEmailsToDeletedItemsFolder()

On Error GoTo errorHandler

Dim sourceWorksheet As Worksheet
Set sourceWorksheet = ThisWorkbook.Worksheets("Sheet1") 'change the sheet name accordingly

Dim EmailsToDelete As Variant
Dim lastRow As Long
With sourceWorksheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
EmailsToDelete = .Range("A1:A" & lastRow).Value
End With

Dim olApp As Outlook.Application
Set olApp = New Outlook.Application

Dim olNS As Outlook.Namespace
Set olNS = Outlook.GetNamespace("MAPI")

Dim olInbox As Outlook.Folder
Set olInbox = olNS.GetDefaultFolder(olFolderInbox)

Dim olDeletedItemsFolder As Outlook.Folder
Set olDeletedItemsFolder = olNS.GetDefaultFolder(olFolderDeletedItems)

Dim olItem As Variant
Dim olMailItem As Outlook.MailItem
Dim deletedEmailCount As Long
Dim i As Long
deletedEmailCount = 0
With olInbox
For i = .Items.Count To 1 Step -1
If .Items(i).Class = olMail Then
Set olMailItem = .Items(i)
If Not IsError(Application.Match(olMailItem.SenderEmailAddress, EmailsToDelete, 0)) Then
olMailItem.Move olDeletedItemsFolder
deletedEmailCount = deletedEmailCount + 1
End If
End If
Next i
End With

MsgBox "Emails moved to deleted items folder: " & deletedEmailCount, vbInformation

exitHandler:
Set olApp = Nothing
Set olNS = Nothing
Set olInbox = Nothing
Set olDeletedItemsFolder = Nothing
Set olMailItem = Nothing

Exit Sub

errorHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Error"
Resume exitHandler

End Sub


Thanks again,
Tom

 

[Domenic]

Are your emails in your default inbox? Or are they in a subfolder?

For testing purposes only, try replacing the With/End With statement with the following, run it, and check the Immediate Window (Ctrl+G) to see whether any email addresses get printed, and whether any of them actual match any in your worksheet list.

    With olInbox
        For i = .Items.Count To 1 Step -1
            If .Items(i).Class = olMail Then
                Set olMailItem = .Items(i)
                Debug.Print olMailItem.SenderEmailAddress
            End If
        Next i
    End With

 

[tommyclearyuk]

FYI, my account is linked via IMAP from my Yahoo to Outlook, would this be a factor in this issue?

I'll follow your advice in your prev note.

Cheers,
T

 

[tommyclearyuk]

Just spotted something else which I assume will have a bearing on the success of this routine, I can see that via my recent Excel upgrade to 2016, my Deleted Items folder does now in fact sit as a sub folder under the, 'Trash,' folder.

Sorry, I didn't spot this in the new version.

This is probably the cause of the issue, do I just require an amend of the text in the code that state 'DeletedItems' to 'Trash?'

Thank you, thank you, thank you.

 

[Domenic]

If your IMAP account is not the default account, you'll need to explicitly name the IMAP store/folder to access its Inbox. Is it your default account? If not, try accessing your Inbox as follows...

Set olInbox = olNS.Folders("FolderName").Folders("Inbox")

Change the folder name accordingly. Then, for your Deleted Items folder, try...

Set olDeletedItemsFolder = olNS.Folders("FolderName").Folders("Deleted Items")

However, if your Deleted Items folder is a subfolder within the Trash folder, try the following instead...

Set olDeletedItemsFolder = olNS.Folders("FolderName").Folders("Trash").Folders("Deleted Items")