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!
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?
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.
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.
adam Jan 29
I wasn’t aware of that! I’ll check it out.
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
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!
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.
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.
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).
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.
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.
April Nov 20
THANK YOU. My office recently migrated to Outlook, and this just saved my sanity.