Back so soon? This article is hot on the heels of the previous one, inspired by some very positive feedback straight after the publishing of the first part. So, if you want the next part quickly, let me know! A bit of encouragement is always welcome!
Anyway, in this part were going to tackle something a bit more useful in Outlook filtering!
Now, if every one is surfing comfortably, Ill begin
There are many uses of filtering your email. Outlook comes with quite a few nifty little gadgets for helping you to filter your mail, such as the Rules Wizard and the Junk Email options. But sometimes that just isnt quite enough, or you may want to get certain mails outside of Outlook.
This article came about after I wrote a little program to read a bunch of mails in a certain folder (placed in there by an Outlook rule), which filtered out any duplicate mails and any mails that my program deemed to be blank.
After whipping this up with a few extra little features in about 2 hours I was amazed how easy yet powerful the object model is.
So, without further unnecessary tales of my programming tasks, Ill take you into some code!
Right, lets get our heads down to some serious code! Reading through messages in a given folder was introduced to you in the previous article, so you should be up to speed on that. Now the first thing Im going to show you is an easy way to get only the latest messages, within a few days of the current date:
(For this code you need a list box called lstNewMessages and a text box called txtDate with a .text value of something like 01/01/01)
Private Sub Form_Load() Dim objOutlook As New Outlook.Application Dim objNameSpace As Outlook.NameSpace Dim objFolder As MAPIFolder Dim objMail As MailItem ' Get the MAPI name space Set objNameSpace = objOutlook.GetNamespace("MAPI") ' Get a ref to the folder we want Set objFolder = objNameSpace.GetDefaultFolder(olFolderInbox) ' Read through all the items For i = 1 To objFolder.Items.Count Set objMail = objFolder.Items(i) ' Check the sent date for validity If objMail.SentOn >= CDate(txtDate.Text) Then ' Add it to the list box lstNewMessages.AddItem objMail.Subject lstNewMessages.ItemData(lstNewMessages.NewIndex) = i End If Next iEnd Sub
OK. This is a pretty basic start. Lets move on to something a bit more demanding…
Heres a little program that reads in messages from a folder in Outlook, then checks for duplicate messages & messages deemed blank, and applies a date cut off point:
(N.B. This code requires the following controls to be loaded on a form: a list box called lstEntries, a text box called txtDate with a value similar to 01/01/01 and two check boxes called chkDups and chkDate)
Option ExplicitDim objOutlook As New Outlook.ApplicationDim objNameSpace As Outlook.NameSpaceDim objInbox As MAPIFolderDim objFolder As MAPIFolderDim objMail As MailItemSub CreateOutlookProc() ' 'Reads in the contents of a folder 'If remove dups & blanks is set, then 'duplicate entries and blanks are filtered out 'Also supports a date cut off point ' Dim i Dim sd As Date lstEntries.Clear 'Get the folder Set objNameSpace = objOutlook.GetNamespace("MAPI") Set objInbox = objNameSpace.GetDefaultFolder(olFolderInbox) Set objFolder = objInbox.Folders("My Folder") 'Read through all items and filter as necessary For i = 1 To objFolder.Items.Count Set objMail = objFolder.Items(i) 'Check for duplicates If chkDups.Value = vbChecked Then If CheckForDups(objMail.SenderName) <> -1 Then Add2List objMail.SenderName, i, CDate(Format(objMail.ReceivedTime, "dd/mm/yy")) End If Else Add2List objMail.SenderName, i, objMail.ReceivedTime End If Next i End SubFunction CheckForDups%(sName$) ' 'Checks a list box for duplicate items ' Dim i For i = 0 To lstEntries.ListCount If lstEntries.List(i) = sName$ Or sName$ = "" Then CheckForDups = -1 Exit Function End If Next iEnd FunctionFunction CheckDate%(dDate As Date) ' 'Checks the date given against the allowed 'cut off date ' 'Returns true if the date is invald ' If dDate > CDate(txtDate.Text) Then CheckDate% = -1 Else CheckDate% = 0 End IfEnd FunctionSub Add2List(sName$, ipos, dDate As Date) ' 'Adds a value to the list box ' If chkDate.Value = vbChecked Then If CheckDate%(dDate) <> -1 Then lstEntries.AddItem sName$ lstEntries.ItemData(lstEntries.NewIndex) = ipos End If Else lstEntries.AddItem sName$ lstEntries.ItemData(lstEntries.NewIndex) = ipos End If lblCount.Caption = "No of entries: " + Str(lstEntries.ListCount)End Sub
Right! Thats about it for this week! Next week well look at:
-Moving through ALL the folders in your mail profile
-Handling different types of items (contacts etc)
-Getting a grip on some more filtering
Until then, enjoy!
Sam
