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