Microsoft Outlook 2003 Tip: VBA Macro to Remove Stationery from Email Message

Quick link to ClearStationery.bas

I don’t have much (any?) history of posting tips for the Windows platform, but I’m currently stuck with it for daily work use, so I figured I might as well share some tips that my readers who happen to be in the same predicament will find useful. (Planet Debian readers please have mercy.)

One of the worst things you that Microsoft Outlook allows a user to do is select a “stationery” for email. Stationery goes beyond regular old HTML mail (e.g., fonts, colors, and bullet lists) to add a patterned background, invariably rendering the content much less readable than it would be with a white (or even any other color) background. What’s worse is every reply to an email with stationery also adopts the original sender’s stationery!

I searched quite a bit for a solution that does not involve sending a nastygram to the original sender. Of course you can convert the email to plain text (or set Outlook to only display the plain text version) and then convert back to HTML or Rich Text, but you’ll also lose other formatting that you might want to retain. You could cut and paste the text into a new email, but what is really needed is a simple VBA macro that will strip the stationery but not other formatting.

Strangely, I don’t think that macro already exists. So I wrote one, to some extent cribbing from related code snippets (mostly from here). I now present to the world ClearStationery.bas, my best contribution to date to the Outlook ecosystem. Simply paste it into your Outlook Visual Basic Editor (ALT-F11) and then map the macro ClearStationeryFormatting() onto a toolbar with a hotkey, and you can instantly remove stationery from any email, whether it is in the “preview” pane or the full message view.

Comments, bug reports, and improvements are welcome:

Sub ClearStationeryFormatting()
On Error GoTo ClearStationeryFormatting_Error
    Dim strEmbeddedImageTag As String
    Dim strStyle As String
    Dim strReplaceThis As String
    Dim intX As Integer, intY As Integer
    Dim myMessage As Outlook.MailItem

    ' First, check to see if we are in preview-pane mode or message-view mode
    ' If neither, quit out
    Select Case TypeName(Outlook.Application.ActiveWindow)
        Case "Explorer"
            Set myMessage = ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set myMessage = ActiveInspector.CurrentItem
        Case Else
            MsgBox ("No message selected.")
            Exit Sub
    End Select

    ' Sanity check to make sure selected message is actually a mail item
    If TypeName(myMessage) <> "MailItem" Then
       MsgBox ("No message selected.")
       Exit Sub
    End If

    ' Remove attributes from <BODY> tag
    intX = InStr(1, myMessage.HTMLBody, "<BODY", vbTextCompare)
    If intX > 0 Then
        intY = InStr(intX, myMessage.HTMLBody, ">", vbTextCompare)
        strReplaceThis = Mid(myMessage.HTMLBody, intX, intY - intX + 1)
    End If

    If strReplaceThis <> "" Then
        myMessage.HTMLBody = Replace(myMessage.HTMLBody, strReplaceThis, "<BODY>")
        strReplaceThis = ""
    Else
        Err.Raise vbObjectError + 7, , "An unexpected error occurred searching for the BODY tag in the e-mail message."
        Exit Sub
    End If

    ' Find and replace <STYLE> tag
    intX = InStr(1, myMessage.HTMLBody, "<STYLE>", vbTextCompare)
    If intX > 0 Then
        intY = InStr(8, myMessage.HTMLBody, "</STYLE>", vbTextCompare)
        strReplaceThis = Mid(myMessage.HTMLBody, intX, ((intY + 8) - intX))
    End If

    If strReplaceThis <> "" Then
        myMessage.HTMLBody = Replace(myMessage.HTMLBody, strReplaceThis, "")
    End If

    If InStr(1, myMessage.HTMLBody, "<center><img id=", vbTextCompare) > 0 Then
        strEmbeddedImageTag = "<center><img id="
        '"<center><img id=""ridImg"" src="citbannA.gif align=bottom></center>"
        intX = InStr(1, myMessage.HTMLBody, strEmbeddedImageTag, vbTextCompare)
        If intX = 0 Then
            Err.Raise vbObjectError + 8, , "An unexpected error occurred searching for the embedded image file name start tag in the e-mail message."
            Exit Sub
        End If
        intY = InStr(intX + Len(strEmbeddedImageTag), myMessage.HTMLBody, " align=bottom></center>", vbTextCompare)
        If intY = 0 Then
            Err.Raise vbObjectError + 9, , "An unexpected error occurred searching for the embedded image file name end tag in the e-mail message."
            Exit Sub
        End If
        strEmbeddedImageTag = Mid(myMessage.HTMLBody, intX, intY - intX)
        intX = InStr(1, myMessage.HTMLBody, "<CENTER>", vbTextCompare)
        intY = InStr(intX, myMessage.HTMLBody, "</CENTER>", vbTextCompare)
        strReplaceThis = Mid(myMessage.HTMLBody, intX, intY - intX) & "</CENTER>"
        myMessage.HTMLBody = Replace(myMessage.HTMLBody, strReplaceThis, "", , , vbTextCompare)
    End If

    ' Finally, saved modified message
    myMessage.Save

    On Error GoTo 0
    Exit Sub

ClearStationeryFormatting_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
    Resume Next
End Sub

Stationery-B-Gone!

33 comments

  1. Anonymous Jan 26

    Do you actually use Outlook, or do you just collaborate with people who do? If the former, does Evolution not work for you?

  2. adam Jan 27

    I have to use Windows XP and Outlook for work. I did try using Evolution with Exchange a few years back and got mixed results. My current workplace has many tightly integrated (some home-grown) systems, all Windows-based, several of which don’t run under Wine. I’m pretty much stuck for the foreseeable future.

  3. Anonymous Jan 28

    I didn’t necessarily suggest running Evolution on Linux. Evolution has a Windows port now, so you wouldn’t have to change the rest of your environment.

  4. adam Jan 29

    I wasn’t aware of that! I’ll check it out.

  5. JP Jan 31

    Nice job on the code! I have similar code on my site. You might want to consider using line continuations (underscores) to make the code more readable. The text box on the blog is not wide enough to display the code properly.

    HTH,
    JP

  6. Mary Feb 11

    nice!

    but it still keeps the font of the sender’s stationary? can you add something to strip their font and utilize our default one?

    thanks! good job!

  7. adam Mar 9

    Changing the font etc. can be done through the Outlook interface, while removing the stationery background cannot be done (to my knowledge) except with my script posted here. I agree a nice revision would be to remove the stationery font tags, and it probably wouldn’t be hard to do based on my existing code, so I’ll try to get it to it sometime.

  8. Matthew Mar 19

    Great piece of code!!! I needed one to do just what this one does, thank you very much. Before I found this one, I found one that I was able to call through an outlook rule. However this one does not show up on the list of available scripts to run when I try to set this up. I know very little about VBA (that is to say I know how to get to the editor), so please help me. Why does it now show there, when it is plainly in the editor and I can run it manualy.

    Thank you.

  9. adam Mar 19

    Matthew: I don’t know the answer to your question. I’ve had that problem before, and I think ultimately I had to implement the VBA hook entirely encode without using the “rules” interface at all. I just set this script up to be a keystroke-activated macro on a toolbar, and only use it when I need it (i.e., on emails with annoying stationery).

  10. Erin Jul 22

    This is exactly what I’m looking for. This stupid stationary makes me nuts! However, I’m not exactly too savvy with Visual Basic. Can somebody maybe give me a ‘plain English’ explaination? Much appreciated.

  11. You’re a genius! Nov 19

    Thanks for this wonderful code. You save me from looking like a random frilly person every time I receive one of those beautiful pieces of stationery.

  12. April Nov 20

    THANK YOU. My office recently migrated to Outlook, and this just saved my sanity.

  13. Glen Coakley Mar 16

    If you define the method as below instead of with no arguments:

    Sub ClearStationeryFormatting(Item As Outlook.MailItem)
    

    then, it will show up as a script that can be used with a mail rule.

  14. Ryan Mar 26

    mmmm… This is bangin’ Thanks, I have an enduser that incessently uses stationery and this makes me very happy.

  15. Matt Aug 21

    Seriously, it is unbelievable that Microsoft didn’t include a function (built-in) that does this exact thing. You are a sanity saver.

    Few things in life are as annoying as outlook stationary used in a professional setting.

  16. Bruce Aug 27

    I’m a unix person forced to use outlook. After I type Alt-F11 I get Visual Basic, but I have no idea how to “map the macro ClearStationeryFormatting() onto a toolbar with a hotkey” What do I do next? I can’t just paste the code. Can someone tell me click this, click that, paste, do this, do that
    I don’t even see File->Exit in the Visual Basic window.

    After removing the stationary, how do I force background color? Idiots here used everything from black to white, with a lot of pastels, and they change depending on the phase of the moon. Simply forcing font color doesn’t work.

  17. Adam Rosi-Kessel Aug 27

    Bruce — just right-click on the toolbar and choose “customize,” then you should be able to drag your macro onto the toolbar to execute it. In my experience, it’s always removed the background color etc., I haven’t found it necessary to do any further customization.

  18. Bruce Aug 28

  19. Bruce Aug 28

    Thanks, but after the rule runs now I am seeing black text on a black background. ??? My defaults are black background with white text. Most people (here) use bright backgrounds with “auto” color. What’s going on?

  20. Adam Rosi-Kessel Aug 28

    I don’t know — beyond my expertise. But typically I’ve only seen white backgrounds in standard installations.

  21. Lynn Sep 22

    works with Outlook 2003 xp2 just beautifully. THANK YOU.

  22. JMB Feb 12

    Adam — this looks great. But I confess I have no idea how to paste your VBA macro into outlook visual basic or how to map it. Would you be willing to provdie a short step by step tutorial? I really need this macro. thx.

  23. Paul Mar 25

    you’re a lifesaver. no more backgrounds in emails! thanks.

  24. Laura May 6

    Thanks for sharing this article. This is working with office 2007.

  25. Mike Sep 29

    Excellent code! One question: A lot of emails I see with stationary also seem to have a double carriage return on Enter that carries into the reply message as well. What could I add to the VBA code to remove that pesky feature?

  26. Eric Feb 10

    Thank you so much. First time I’ve ever created a macro so I kind of fumbled through the process. basically created a Module, pasted your code into that module then figured out where the Macro was in the Ribbon.

    Works very nicely. Only one thing can it remove the stationary automatically when I receive a message?

  27. Omar Apr 2

    Thanks for this tip

    I receive a lot of emials.
    That i Want is identify a html format, to export valules that comes into a table, to a excel application, automatically.

    I am running this script like a rule.

    The problem is that my initial scrpit, not function when the table into email with html format, comes in a different position, because i am reading it like a text format.

    I tried to change especial characters like vbCrLf by “;”, but if the table change the position, i could not find the values at the same position.

    I appreciated your comments, I want to read this email like a html format, to identify the tags.

    Sub GetData()

    Dim msg As Outlook.MailItem
    Dim rows As Variant
    Dim numberofColumns As Long
    Dim numberofRows As Long
    Dim headerValues As Variant
    Dim headerRow() As String
    Dim data() As String
    Dim i As Long, k As Long, j As Long
    Dim cont As String
    Dim Val As String

    Dim myXLApp As Excel.Application
    Dim myXLWB As Excel.Workbook
    Dim Asunto As String
    Dim TotalRows As Integer

    Dim objRegExp As RegExp
    Dim objMatch As Match
    Dim colMatches As MatchCollection
    Dim RetStr As String
    Dim cadena As String
    Dim Ncadena As String
    Dim myPattern As String

    Set msg = ActiveExplorer.Selection.item(1)
    Set myXLApp = New Excel.Application
    myXLApp.Visible = True
    Set myXLWB = myXLApp.Workbooks.Open(“D:\ibague_sigma\UMTS\ControlIncidenciasUmts.xls”)

    ‘Val= “] >.+”
    ‘Val= “] >.+”
    ‘Val= “] >.+”
    ‘Val = Chr(13) & Chr(10) & ” ”

    msg.Body = Replace(msg.Body, vbCrLf, “;”)

    Set objRegExp = New RegExp
    objRegExp.Pattern = “;+”

    objRegExp.IgnoreCase = True
    objRegExp.Global = True
    ‘msg.Body
    If (objRegExp.Test(msg.Body) = True) Then
    MsgBox objRegExp.Replace(msg.Body, “;”)
    msg.Body = msg.Body & vbCrLf & objRegExp.Replace(msg.Body, “;”)
    rows = Split(objRegExp.Replace(msg.Body, “;”), “;”)
    End If

    ‘La última
    TotalRows = Sheets(1).Range(“A65536″).End(xlUp).Row
    j = TotalRows + 1

    Asunto = msg.Subject

    For i = LBound(rows) To UBound(rows)
    MsgBox rows(i)
    cont = cont & vbCrLf & i & “;” & rows(i)
    MsgBox cont
    Next

    With myXLWB.Worksheets(1)
    .cells(j, 1).Value = Asunto
    .cells(j, 2).Value = rows(2)
    .cells(j, 3).Value = rows(6)
    .cells(j, 4).Value = rows(9)
    .cells(j, 5).Value = rows(10)
    .cells(j, 6).Value = rows(17)
    .cells(j, 7).Value = rows(23)
    .cells(j, 8).Value = rows(27)
    .cells(j, 9).Value = rows(31)
    .cells(j, 10).Value = rows(36)
    .cells(j, 11).Value = rows(40)
    .cells(j, 12).Value = rows(48)
    .cells(j, 13).Value = rows(54)
    .cells(j, 14).Value = rows(60)
    .cells(j, 15).Value = rows(66)
    .cells(j, 16).Value = rows(72)
    .cells(j, 17).Value = rows(78)
    .cells(j, 18).Value = rows(84)
    .cells(j, 19).Value = rows(90)
    End With

    msg.Body = cont

    myXLWB.Save
    myXLWB.Close

    End Sub

    thanks a lot
    Omar

  28. Suzanne Phillips Jul 10

    Thank you, you are my HERO!!!! I have no experience with visual basics but you provided me with enough information to make this change. Thank you for sharing this fix.

  29. Philippe Galtier May 8

    Adam,
    Congratulations and a big thank you for your creation. It works perfect at removing alleged art and personal expression in HTML e-mails. A little disk space can be saved!
    Phil

  30. Bryan May 15

    This works great until I close Outlook. Once Outlook has been closed the first time after adding the macro, it no longer functions. Any ideas? It’s Outlook 2010 on Win7 Pro

  31. Lydia Nov 18

    I bow to your infinite genius.

  1. Code For Excel And Outlook Blog » VBA Macro to Remove Stationery from Email Message
  2. VBA Macro to Remove Stationery from Email Message » Code For Excel And Outlook

Leave a Reply

(Markdown Syntax Permitted)