Auto Run VBA Code on new email

[crashoz]

Hi, I have found a very useful VBA code to remove a line of text in an email but I need to run it manually for it to work.

What would I need to add in order to have it automatically run each time i receive a new email in my inbox?

Option Explicit

Sub RemoveExpressionFOLDER()

Dim outFldr As Folder
Dim outItems As Items
Dim outMailItem As MailItem

Dim i As Long
Dim cleanCount As Long

Set outFldr = ActiveExplorer.CurrentFolder

Set outItems = outFldr.Items

For i = 1 To outItems.Count

    If outItems(i).Class = olMail Then

        Set outMailItem = outItems(i)

        With outMailItem

            'Debug.Print .Subject

            If InStr(.body, "words to remove here ") Then

                If .BodyFormat = olFormatHTML Then
                    .HTMLBody = Replace(.HTMLBody, "words to remove here", "")
                Else
                    .body = Replace(.body, "words to remove here", "")
                End If

                .Save

                cleanCount = cleanCount + 1

             End If

          End With

     End If

    Next i

End Sub

 

[Diane Poremsky]

To use it manually, this line needs to go:
Set outMailItem = outItems(i)
replace with
Set outMailItem = objApp.ActiveExplorer.Selection.Item(1)

once you do that, these lines won't be doing anything
Set outFldr = ActiveExplorer.CurrentFolder
Set outItems = outFldr.Items
For i = 1 To outItems.Count
If outItems(i).Class = olMail Then

This:
cleanCount = cleanCount + 1

or these:
End If
Next i

To run it when mail arrives, you can either use a rule or an itemadd macro that watches the folder.

For a rule, you need to change the name name line to this:
Public Sub RemoveExpressionFOLDER(outMailItem As Outlook.MailItem)
and remove all of the lines mentioned above.

To test the script on a selected message (or just to use it manually), select a message and run this macro. It calls the run a script rule.

Sub RunScript()
Dim objApp As Outlook.Application
Dim objItem As Object ' MailItem
Set objApp = Application
Set objItem = objApp.ActiveExplorer.Selection.Item(1)

'macro name you want to run goes here
RemoveExpressionFOLDER objItem

End Sub

Outlook's Rules and Alerts: Run a Script (slipstick.com)

How to use an ItemAdd Macro (slipstick.com)

Outlook VBA: Work with Open Item or Selected Item (slipstick.com)