Automatically print incoming emails
January 6, 2010 @ 7:30 AM by JP • 69 views • 2 Comments »
Another post in the Save Money, use VBA series.
Automatically print incoming emails
To automatically print out emails using an event handler, see below. Starting with the code found at Stock Event Code, call the MailItem.PrintOut Method. Unfortunately, this method cannot be customized at all, so the email comes out very plain, with all the fields arranged as Outlook sees fit.
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Set Items = GetItems(GetNS(GetOutlookApp), olFolderInbox)
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim destfldr As Outlook.MAPIFolder
If Not IsMail(item) Then GoTo ProgramExit
Set Msg = item
Msg.PrintOut
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.number & " - " & Err.Description
Resume ProgramExit
End Sub
Function IsMail(itm As Object) As Boolean
IsMail = (TypeName(itm) = "MailItem")
End Function
Function GetItems(olNS As Outlook.NameSpace, _
folder As OlDefaultFolders) As Outlook.Items
Set GetItems = olNS.GetDefaultFolder(folder).Items
End Function
Function GetOutlookApp() As Outlook.Application
' returns reference to native Application object
Set GetOutlookApp = Outlook.Application
End Function
Function GetNS(ByRef app As Outlook.Application) As Outlook.NameSpace
Set GetNS = app.GetNamespace("MAPI")
End Function
Private Sub Application_Startup()
Set Items = GetItems(GetNS(GetOutlookApp), olFolderInbox)
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim destfldr As Outlook.MAPIFolder
If Not IsMail(item) Then GoTo ProgramExit
Set Msg = item
Msg.PrintOut
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.number & " - " & Err.Description
Resume ProgramExit
End Sub
Function IsMail(itm As Object) As Boolean
IsMail = (TypeName(itm) = "MailItem")
End Function
Function GetItems(olNS As Outlook.NameSpace, _
folder As OlDefaultFolders) As Outlook.Items
Set GetItems = olNS.GetDefaultFolder(folder).Items
End Function
Function GetOutlookApp() As Outlook.Application
' returns reference to native Application object
Set GetOutlookApp = Outlook.Application
End Function
Function GetNS(ByRef app As Outlook.Application) As Outlook.NameSpace
Set GetNS = app.GetNamespace("MAPI")
End Function
I'm just an average guy who writes VBA code for a living. This is my personal blog. Excel and Outlook are my thing, with a sprinkle of Access and Word here and there. Follow this space if you want to learn more about VBA. Keep Reading »
Previous Post: The JKP Name Manager just saved my bacon
Next Post: Major blog/site changes
This only saves money if you have good
filters and avoid printing all that spam.
What I meant was, it saves you from having to buy an add-in that does the same thing.