Замена частей тела при сохранении HTML

Question

Я пытаюсь найти & заменить части тела HTML. Мне удалось это сделать, но не использовать HTML-код, поэтому, как только я запустил макрос, тело письма станет открытым текстом.

Это то, что я пытался сначала:

Sub ReplaceText() 

Dim Insp As Inspector 
Dim obj As Object 

    Set Insp = Application.ActiveInspector 
    Set obj = Insp.CurrentItem 

    obj.Body = Replace(obj.Body, "TEXT TO FIND", "TEXT TO REPLACE WITH") 

    Set obj = Nothing 
    Set Insp = Nothing 

End Sub 

Поскольку это не сработало, я пытаюсь использовать WordEditor. Мой текущий код ничего не делает.

Public Sub ReplaceText() 
    Dim objItem As Object 
    Dim objInsp As Outlook.Inspector 

    Dim objWord As Word.Application 
    Dim objDoc As Word.Document 
    Dim objSel As Word.Selection 
    On Error Resume Next 

    Set objItem = Application.ActiveInspector.CurrentItem 
    If Not objItem Is Nothing Then 
     If objItem.Class = olMail Then 
      Set objInsp = objItem.GetInspector 
      If objInsp.EditorType = olEditorWord Then 
       Set objDoc = objInsp.WordEditor 
       Set objWord = objDoc.Application 
       Set objSel = objWord.Selection 

       With objSel.Find 
       .Text = "This is an online meeting" 
       .Replacement.Text = "TEST TEST" 
       .Execute Replace:=wdReplaceAll 
       End With 

      End If 
     End If 
    End If 

    Set objItem = Nothing 
    Set objWord = Nothing 
    Set objSel = Nothing 
    Set objInsp = Nothing 
End Sub 

Answer 1

Вы должны заменить .body с .HTMLBody в исходной функции и что должно работать.

Редактировать - это функция, которая работает для меня.

Sub ReplaceText() 

Dim Insp As Inspector 
Dim obj As Object 

Set Insp = Application.ActiveInspector 
Set obj = Insp.CurrentItem 

obj.HTMLBody = Replace(obj.HTMLBody, "TEXT TO FIND", "TEXT TO REPLACE WITH") 

Set obj = Nothing 
Set Insp = Nothing 

End Sub 

Answer 2

Как о выборе Сообщ

Option Explicit 
Sub ReplaceText() 
    Dim olItem As Outlook.MailItem 

    '//- Selected msg 
    If Application.ActiveExplorer.Selection.Count = 0 Then 
     Exit Sub 
    End If 

    For Each olItem In Application.ActiveExplorer.Selection 
     If olItem.Class = olMail Then 
      olItem.HTMLBody = Replace(olItem.HTMLBody, "TEXT TO FIND", "TEXT TO REPLACE WITH") 
     End If 
    Next 
End Sub