Script to remove overly-long external email notification

I'm using this at the moment, and it works but it also strips all in-line images from the body which is not ok.
Is there a way to remove only this text at the top of the email but not break the formatting or contents of the rest of the email?

Code:

---

Sub ShrinkAlert(MyMail As MailItem)
    Dim body As String, re As Object, match As Variant


    body = MyMail.body
        body = Replace(body, "CAUTION! This is an EXTERNAL email originated from outside the organization. Do not click links or open attachments unless you recognize the sender and know the content is safe. ", "EXTERNAL:", 1, -1, vbTextCompare)


    MyMail.body = body
    MyMail.Save
End Sub

---

My source info:
Replace Text: https://superuser.com/questions/4640...rlink-in-outlo
Enable Run Script rule: https://www.slipstick.com/outlook/ru...-script-rules/
Allow Macros: https://www.techrepublic.com/article...0(Figure%20A).

I think the following should work for you

Code:

---

Sub ShrinkAlert(MyMail As MailItem)
Dim olInsp As Inspector
Dim wdDoc As Object
Dim oRng As Object
Const sText As String = "CAUTION! This is an EXTERNAL email originated from outside the organization. Do not click links or open attachments unless you recognize the sender and know the content is safe."
    With MyMail
        .Display
        Set olInsp = .GetInspector
        If Not (MyMail.Recipients Is Nothing) And Not (MyMail.sender Is Nothing) Then
            'open in "Edit" mode
            olInsp.CommandBars.ExecuteMso ("EditMessage")
        End If
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        With oRng.Find
            Do While .Execute(findText:=sText)
                oRng.Text = "EXTERNAL: "
                oRng.Font.Color = &HFF&
                oRng.collapse 0
                Exit Do
            Loop
        End With
        .Save
        .Close 1
    End With
End Sub

---

It opened the first email in a new window and returned a Rule in Error warning "An unexpected error has occurred"

The code is intended to run from a rule when the messages arrive. I have added a trap for appointment items and set the resulting message as unread, but otherwise it should work and certainly does here

Code:

---

Sub ShrinkAlert(MyMail As MailItem)
Dim olInsp As Inspector
Dim wdDoc As Object
Dim oRng As Object
Const sText As String = "CAUTION! This is an EXTERNAL email originated from outside the organization. Do not click links or open attachments unless you recognize the sender and know the content is safe."
    If TypeName(MyMail) = "MailItem" Then
        With MyMail
            .Display
            Set olInsp = .GetInspector
            If Not (MyMail.Recipients Is Nothing) And Not (MyMail.sender Is Nothing) Then
                'open in "Edit" mode
                olInsp.CommandBars.ExecuteMso ("EditMessage")
            End If
            Set wdDoc = olInsp.WordEditor
            Set oRng = wdDoc.Range
            With oRng.Find
                Do While .Execute(findText:=sText)
                    oRng.Text = "EXTERNAL: "
                    oRng.Font.Color = &HFF&
                    oRng.collapse 0
                    Exit Do
                Loop
            End With
            .Save
            .Close 1
            .UnRead = True
        End With
    End If
lbl_Exit:
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

---