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.
Glen Coakley Mar 16
If you define the method as below instead of with no arguments:
then, it will show up as a script that can be used with a mail rule.
Ryan Mar 26
mmmm… This is bangin’ Thanks, I have an enduser that incessently uses stationery and this makes me very happy.
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.
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.
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.
Bruce Aug 28
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?
Adam Rosi-Kessel Aug 28
I don’t know — beyond my expertise. But typically I’ve only seen white backgrounds in standard installations.
Lynn Sep 22
works with Outlook 2003 xp2 just beautifully. THANK YOU.
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.
Paul Mar 25
you’re a lifesaver. no more backgrounds in emails! thanks.
Laura May 6
Thanks for sharing this article. This is working with office 2007.
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?
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?
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
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.
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
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
Lydia Nov 18
I bow to your infinite genius.
Tim Oct 2
Using Office 2013 and this still works. Thank you.