February 25, 2021
Hot Topics:

Making Microsoft Outlook Useful - Part 2

  • By Sam Huggill
  • Send Email »
  • More Articles »

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!


Page 4 of 4

This article was originally published on November 20, 2002

Enterprise Development Update

Don't miss an article. Subscribe to our newsletter below.

Thanks for your registration, follow us on our social networks to keep up-to-date