Need help with OutlookVBA for finding and replacing the text from original email

[Ratish]

Hi,

Not sure if I am posting below query to correct audience.

I am trying to run outlook VBA to find and replace text from original email to new email to bunch of stakeholders. Finding difficulty to run the script.
Scenario, I get an email which has Company Name list. So whenever I am running this script it should replace with company name listed on the original email. Below is my script.

Sub Test()
Dim origEmail As MailItem
Dim replyEmail As MailItem
Dim oRespond As Outlook.MailItem
Dim strcompany As String
Dim strHTML As String

Set origEmail = Application.ActiveWindow.Selection.Item(1)
Set replyEmail = Application.CreateItemFromTemplate("C:\Users\test-.oft")
strcompany = InputBox("Issue : ", "Replace %company%")
strHTML = Replace(replyEmail.HTMLBody, "Company:", strissue)
replyEmail.HTMLBody = replyEmail.HTMLBody & origEmail.Reply.HTMLBody
replyEmail.Subject = replyEmail.Subject & origEmail.Reply.Subject


replyEmail.Display

End Sub

[gmayor]

It is not exactly clear what you are trying to achieve, but the basic code to replace text in a message body is

Sub ReplaceText()
Dim olItem As Outlook.MailItem
Dim olEmail As Outlook.MailItem
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Const sFindText As String = "%Company%"
Const sReplaceText As String = "The Widget Company"
    Set olEmail = ActiveExplorer.Selection.Item(1)
    Set olItem = CreateItemFromTemplate("C:\Users\test.oft")
    With olItem
        .subject = olEmail.subject
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        .Display
        With oRng.Find
            Do While .Execute(findText:=sFindText)
                oRng.Text = sReplaceText
                oRng.collapse 0
            Loop
        End With
    End With
lbl_Exit:
    Exit Sub
End Sub