Printing First Page of Email in Outlook
I print out my email. No, I'm not one of the Luddites that prints out every email (or has his secretary do it) because he doesn't understand how to work his email machine. My system for organization is loosely based on Getting Things Done and its derivative 43 Folders. Everything I have to do is represented by at least one piece of paper. So don't try to convince me to quit printing my email, because it's not going to happen.
If I get an email that requires some action in the future, I need one of these pieces of paper to represent that future action. Until recently, I would print the email to serve that purpose. As you already know, email can get quite long and that means I can end up with 10 sheets of paper where I only needed one. When you deal with accountants and lawyers, it's even worse because each of their messages in the thread has a page of disclaimers. Oddly, Outlook's print dialog doesn't let you specify a page range. There are some work arounds, but none of them are suitable for me. I read all my email in plain text and I reply in plain text (HTML is for web pages, not email). Since I'm using plain text, I use Outlook's built-in email editor rather than Word.
After I printed seven pages of an email today, I decided to finally write some code. I put a button on my new email commandbar and hooked it up to this procedure:
Dim mi As MailItem
Dim sBody As String
Dim wdApp As Word.Application
Const sORIG As String = "> -----Original Message-----"
If TypeName(Application.ActiveInspector.CurrentItem) = "MailItem" Then 'only mail
'create a forward to get the header
Set mi = Application.ActiveInspector.CurrentItem.Forward
sBody = mi.Body
sBody = Mid(sBody, InStr(1, sBody, sORIG), 5000) 'Remove inserted signature
Set wdApp = New Word.Application
With wdApp.Documents.Add
.Range.Text = sBody
.PageSetup.LeftMargin = 18 '.25"
.PageSetup.RightMargin = 18
.PageSetup.TopMargin = 18
.PrintOut False, False, wdPrintFromTo, "", "1", "1"
End With
wdApp.Quit False 'don't save changes
Set wdApp = Nothing
mi.Close olDiscard 'don't save changes
Set mi = Nothing
End If
End Sub
I didn't want to automate Word to do this, but I struggled with other options to limit it to one page. I know that printing out of Outlook puts 60 lines on the first page. However, when I tried to limit the text to the first 60 vbNewLine's, it didn't quite work out. I started to think that maybe Outlook doesn't put a vbNewLine after each line, but rather after each paragraph. I'm still not sure why that didn't work. So I resigned to automate Word and use it's page range feature to limit the print out.
I limit this to MailItems although it may work on other objects. I didn't want to test it. The MailItem I work with is a forwarded copy of the original. When I forward an email it puts the header information at the top of each email in the thread, so I get some needed information on my print out. Unfortunately, it also puts my signature in there, so I have to strip that part out by starting the string at the Original Message part. And I limit the string to 5,000 because that should be more than one page and there's no need to transfer more than that.
I kept getting a type mismatch error when using Word's PrintOut method. At first I thought it was because I was omitting optional arguments, but that really shouldn't be the case when I'm early binding. I seem to remember a problem with optional arguments using late binding - specifically that you have to include all optional arguments up until the one you want to include, then none after that. But I was still getting the error. Inexplicably, Word wants Strings for page numbers. You'll notice that my page numbers are in quotes.
Finally, I close Word without saving changes and discard the forwarded copy of the email.
