Delete Emails Based upon Subject and File Size

[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