Results 1 to 4 of 4

Thread: VBA code for OUTLOOK to DELETE incoming EMAILS based on text in the BODY

  1. #1
    VBAX Newbie
    Oct 2021

    VBA code for OUTLOOK to DELETE incoming EMAILS based on text in the BODY

    Is there a way using VBA to have OUTLOOK delete any incoming email that meet 2 conditions below.

    Condition #1

    The body of the email must contain the following text string with variable date and time:

    Transaction Date: XX/XX/XXXX XX:XX:XX AM/PM

    Where XX/XX/XXXX is the date written in the following format: m/d/yyyy and time is 12hr time in the following format h:mm:ss AM/PM

    Here is the string with a date and time as an example

    Transaction Date: 9/21/2021 2:13:01 PM

    Note: The body of the email contains other lines of text both before and after this specific string.

    Condition #2

    The date and time shown in the Transaction Date line is no more than 15 minutes from the date/time the email was received (based on the time stamp of the email).
    For example, an email with time stamp 10/21/2021 1:42PM and containing the string below in the body would not be deleted

    Transaction Date: 10/21/2021 1:38:13 PM

    If it was any other date however, or the time was >15mins it would be deleted, like these 2:

    Transaction Date: 10/21/2021 11:01:20 AM


    Transaction Date: 9/3/2021 1:44:01 PM

    If this VBA code is possible, could it instead move the email to a folder named Old Transactions? If so, what would that code look like?

    Also, how would the code change if it only needed to be run to delete/move already received emails?

    Thank you to anyone that can help

  2. #2
    The following should do the trick when run as a script from a rule that acts on all messages (or all messages from a particular sender)
    The code will adapt to either scenario, but if you are moving to a sub folder of Inbox called "Old Transactions" that folder must exist.
    You can test the code on a selected message using the TestCode macro.
    Option Explicit
    Sub TestCode()
    Dim olMsg As MailItem
        On Error Resume Next
        Select Case Outlook.Application.ActiveWindow.Class
            Case olInspector
                Set olMsg = ActiveInspector.currentItem
            Case olExplorer
                Set olMsg = Application.ActiveExplorer.Selection.Item(1)
        End Select
        OldData olMsg
        Exit Sub
    End Sub
    Sub OldData(olItem As MailItem)
    Dim olInsp As Outlook.Inspector
    Dim wdDoc As Object
    Dim oRng As Object
    Dim dDate As Date, dRecDate As Date
    Dim sDate As String, sRecDate As String
    Dim oFldr As Folder
        If TypeName(olItem) = "MailItem" Then
            If InStr(1, olItem.Body, "Transaction Date: ") > 0 Then
                Set oFldr = Session.GetDefaultFolder(olFolderInbox).folders("Old Transactions")
                With olItem
                    Set olInsp = .GetInspector
                    Set wdDoc = olInsp.WordEditor
                    Set oRng = wdDoc.Range
                    With oRng.Find
                        Do While .Execute("Transaction Date: ")
                            oRng.collapse 0
                            oRng.End = oRng.End + 21
                            If IsDate(oRng.Text) = True Then
                                dDate = CDate(oRng.Text)
                                sDate = Format(dDate, "yyyymmddHHMM")
                                dRecDate = DateAdd("n", -15, olItem.ReceivedTime)
                                sRecDate = Format(dRecDate, "yyyymmddHHMM")
                                If Val(sDate) < Val(sRecDate) Then
                                    '    olItem.Delete
                                    olItem.Move oFldr
                                End If
                            End If
                            Exit Do
                    End With
                End With
            End If
        End If
        Set oRng = Nothing
        Set wdDoc = Nothing
        Set olInsp = Nothing
        Set olItem = Nothing
        Set oFldr = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes

  3. #3
    VBAX Newbie
    Oct 2021
    So the code worked -- once -- I think. I'm very new to VBA, so I must be doing something incorrect on my end with the running of the code in VBA. It will do me good to mess with it myself to get it to work again. But.....

    I noticed a mistake on my end and perhaps why I can't get it to work any more.

    The time and date format of the incoming email is in fact in this format:

    Transaction Date: mm/dd/yyyy XX:XX:XX


    Transaction Date: 09/20/2021 03:22:11

    It's 24 hour time with no AM or PM and in the mm/dd/yyyy format

    How would that change the code.

    I was looking at an older email that had a different date/time format.

    Thank you so much for your QUICK help.

  4. #4
    Change the line
    oRng.End = oRng.End + 21
    oRng.End = oRng.End + 19
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes

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