VBA Code to Find & Remove certain text from email body

[Prince27]

Hi All,

I want to find certain text and remove from the body of the mail. Can you help out in providing a macro(VBA Code) to delete specific text from the email body.

For every email the below highlighted text in BOLD is common. But i don't want that information. I want a macro to delete the highlighted text.

For example my body of the mail is as below:


I am contacting you regarding the missing information/documents of this client. Request you to provide the same.


Job ID 13353
:- 1178838
Client/Information/Year : IBM Laptop Manual for the year 2011
: Microsoft Processor Version for the year 2012
Comments Need Original 2 Copies

Request ABC bank to reply with the missing information ASAP. If not, leads to decrease in the production charges.
-----------------------------------

 

[s.ridd]

OK, that still begs the question of why don't you run the code from within Outlook.

However, the last code I gave you will replace the specified text string with "" in the first open email which is exactly what you're asking for. The requirements for what text string needs to be deleted seems to change each time, is this because it will change every time you run it? If not all you need to do is change the text and the procedure should work.

I've modified it again slightly and included a string variable so as it is clearer where you need to put your phrase. If it won't work with your full text string, I suggest creating a new email and in the body write the word "test", then replace the strTextToReplace string with "test" and see if it works. Outlook loves to stick spaces on the ends of lines so if you are trying to remove multiple lines remember that you'll probably need to add a space onto the end of the first line eg:

strTextToReplace = "Line 1 " & vbNewLine & "Line 2 " & vbNewLine

Here is the code - I'm guessing you're probably going to have to change the text to replace though

Sub RemoveExpression()

Dim outApp As Object
Dim outInsp As Object
Dim outObj As Object
Dim strTextToReplace As String


    Set outApp = GetObject(, "Outlook.Application")
    Set outInsp = outApp.ActiveInspector
    Set outObj = outInsp.CurrentItem
    
    strTextToReplace = "Client/Information/Year : IBM --------------------------------Laptop Manual for the year 2011"


    outObj.Body = Replace(outObj.Body, strTextToReplace, "")


    Set outObj = Nothing
    Set outInsp = Nothing
    Set outApp = Nothing


End Sub

 

[Kestis]

Hello,
I have written this code, it works on Outlook 2010, but I am having problems on Outlook 2013. When I start this macro, I get no error, but text is not replaced also. What could be the problem.
Thank You in advance.

Sub RemoveExpression()

Dim outNS As Outlook.NameSpace
Dim outFldr As Outlook.Folder
Dim outMailItems As Outlook.Items
Dim outMailItem As Outlook.MailItem








    Set outNS = Application.GetNamespace("MAPI")
    Set outFldr = outNS.GetDefaultFolder(olFolderDrafts)
    Set outMailItems = outFldr.Items
    
    For Each outMailItem In outMailItems
        
        outMailItem.Body = Replace(outMailItem.Body, ChrW(261), "a")
        outMailItem.Body = Replace(outMailItem.Body, ChrW(269), "c")
        outMailItem.Body = Replace(outMailItem.Body, ChrW(281), "e")
        outMailItem.Body = Replace(outMailItem.Body, ChrW(279), "e")
        outMailItem.Body = Replace(outMailItem.Body, ChrW(303), "i")
        outMailItem.Body = Replace(outMailItem.Body, ChrW(353), "s")
        outMailItem.Body = Replace(outMailItem.Body, ChrW(371), "u")
        outMailItem.Body = Replace(outMailItem.Body, ChrW(363), "u")
        outMailItem.Body = Replace(outMailItem.Body, ChrW(382), "z")
        outMailItem.Body = Replace(outMailItem.Body, ChrW(260), "A")
        outMailItem.Body = Replace(outMailItem.Body, ChrW(268), "C")
        outMailItem.Body = Replace(outMailItem.Body, ChrW(280), "E")
        outMailItem.Body = Replace(outMailItem.Body, ChrW(278), "E")
        outMailItem.Body = Replace(outMailItem.Body, ChrW(302), "I")
        outMailItem.Body = Replace(outMailItem.Body, ChrW(352), "S")
        outMailItem.Body = Replace(outMailItem.Body, ChrW(370), "U")
        outMailItem.Body = Replace(outMailItem.Body, ChrW(362), "U")
        outMailItem.Body = Replace(outMailItem.Body, ChrW(381), "Z")
    Next
    
    Set outMailItems = Nothing
    Set outFldr = Nothing
    Set outNS = Nothing
    
End Sub

 

[Kestis]

Anyone?