Microsoft & .NETVisual BasicMaking Microsoft Outlook Useful - Part 2

Making Microsoft Outlook Useful – Part 2 content and product recommendations are editorially independent. We may make money when you click on links to our partners. Learn More.

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!


Get the Free Newsletter!

Subscribe to Developer Insider for top news, trends & analysis

Latest Posts

Related Stories