Delete Emails Based upon Subject and File Size

[lneidorf]

Hi there.

I've got what seems like a relatively simple task, but cannot figure it out.

I'm running Outlook 2010.

I need to create a VBA macro to delete emails where:
1. Subject contains specific text ("Bloomberg Message" OR "Bloomberg_Message")
2. Message size is larger than 2MB [may use another value here]

I've tried cobbling together various code examples I've found on this forum and else where to no effect. These include:
http://www.vbaexpress.com/forum/showthread.php?47974-Deleting-an-email-using-VBA-in-outlook-when-the-subject-name-contains-certain-words
https://stackoverflow.com/questions/19470564/deleting-an-email-when-subject-contains-certain-words

As a plus, how would I move the messages, in addition to deleting them?

Any help would be most appreciated.

Thanks.

[gmayor]

The following will delete messages that match your description. Because the process can take some time with large folder content, I have included a progress indicator. You will need to download the attachment and import the content into Outlook VBA.

You can move the messages instead of deleting them, but you would have to indicate where you want to move them to. e.g. replace olItem.Delete with
olItem.Move olNS.GetDefaultFolder(olFolderInbox).folders("FolderName")
where foldername is the name of a direct subfolder of the default inbox.

I would suggest testing with the debug line rather than the delete line


Option Explicit

Sub DeleteMessages()
'Graham Mayor - https://www.gmayor.com - Last updated - 20 Apr 2019
Dim olItem As Object
Dim olFolder As Folder
Dim olNS As NameSpace
Dim lngItem As Long
Dim oFrm As New frmProgress
Dim PortionDone As Double
Dim i As Long
Set olNS = Application.GetNamespace("MAPI")
Set olFolder = olNS.PickFolder
oFrm.Show vbModeless
i = 0
For lngItem = olFolder.Items.Count To 1 Step -1
i = i + 1
PortionDone = i / olFolder.Items.Count
oFrm.lblProgress.Width = oFrm.fmeProgress.Width * PortionDone
Set olItem = olFolder.Items(lngItem)
If TypeName(olItem) = "MailItem" Then
If olItem.Size > 2000000 Then
If olItem.Subject Like "*Bloomberg?Message*" Then
'Debug.Print olItem.Subject
olItem.Delete
End If
End If
End If
DoEvents
Next lngItem
Unload oFrm
lbl_Exit:
Set oFrm = Nothing
Set olItem = Nothing
Set olFolder = Nothing
Set olNS = Nothing
Exit Sub
End Sub

[lneidorf]

Graham,

Thanks so much.

I love the idea of a progress indicator. Unfortunately, I'm running this in a secure environment, which prevents me from uploading those files. Can you advise as to how I can revise the code to exclude that?

Many thanks,
Louis Neidorf
MS Novice

[gmayor]

The progress indicator uses the three variables
Dim oFrm As New frmProgress
Dim PortionDone As Double
Dim i As Long

Remove all the references to the three variables.