Consulting

Results 1 to 4 of 4

Thread: Delete Emails Based upon Subject and File Size

  1. #1
    VBAX Regular
    Joined
    Jun 2007
    Posts
    12
    Location

    Delete Emails Based upon Subject and File Size

    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.

  2. #2
    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
    Attached Files Attached Files
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Regular
    Joined
    Jun 2007
    Posts
    12
    Location
    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

  4. #4
    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.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •