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/show...-certain-words
https://stackoverflow.com/questions/...-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.