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

[mb2404]

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


Or


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

[gmayor]

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
lbl_Exit:
    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
                    Loop
                End With
            End With
        End If
    End If
lbl_Exit:
    Set oRng = Nothing
    Set wdDoc = Nothing
    Set olInsp = Nothing
    Set olItem = Nothing
    Set oFldr = Nothing
    Exit Sub
End Sub

[mb2404]

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

Example:

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.

[gmayor]

Change the line

oRng.End = oRng.End + 21

to

oRng.End = oRng.End + 19