Consulting

Results 1 to 4 of 4

Thread: Script to remove overly-long external email notification

  1. #1

    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?

    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).

  2. #2
    I think the following should work for you

    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

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

  4. #4
    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

    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •