VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - 制作OutLook的助手-使用过滤器
发表评论(0)作者:Sam Huggill, 平台:VB6.0+Win98, 阅读:8952, 日期:2001-04-29
Uses of filtering

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 isn’t 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, I’ll take you into some code!

We want 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 I’m 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 i
End Sub
OK. This is a pretty basic start. Lets move on to something a bit more demanding...

Filtering duplicates & blanks with date cut off

Here抯 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 Explicit

Dim objOutlook As New Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim objInbox As MAPIFolder
Dim objFolder As MAPIFolder
Dim objMail As MailItem

Sub 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 Sub

Function 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 i
End Function

Function 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 If
End Function

Sub 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! That抯 about it for this week! Next week we抣l 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!