[Spambayes] Outlook envelope icon

[dickk at paragonconstructioninc.com]

Using Outlook2k

I've read the faq on this and I wanted to share what I was doing.  I'm
hoping that someone has come up with a better way which hasn't made it to
the faq.

I use the Application_NewMail event to create an AppointmentItem with a
start time of Now and ReminderMinutesBeforeStart = 0.  Then I use the
Application_Reminder event to determine the amount of unread mail in my
Inbox.  If none, I delete the envelope icon using Neo's code.  And it
deletes the AppointmentItem whether the envelope is deleted or not.

Here are the problems:
Even though the AppointmentItem is set to remind immediately, it takes
between 10 and 30 seconds for it to actually run.  This means that if I see
an envelope, it may mean I have new mail or it may mean that the reminder
event hasn't run yet.

The reminder is displayed and steals the focus for a split second before
it's deleted.  Normally that's not a problem, but it can be an annoyance if
I'm typing something during that split second.

My deleted items folder has a lot of deleted reminders in it.  I've manually
set up a reminder for every Sunday to delete these reminders from the
deleted items folder, but I won't know if this works well until this Sunday.

Here's the code I'm using:

Private Sub Application_NewMail()

	Dim ai As AppointmentItem

	Set ai = Me.CreateItem(olAppointmentItem)

	With ai
	    .Subject = "ClearEnvelope"
	    .Start = Now + TimeValue("00:00:02")
	    .Duration = 5
	    .ReminderSet = True
	    .ReminderMinutesBeforeStart = 0
	    .ReminderOverrideDefault = True
	    .ReminderPlaySound = False
	    .Save
	End With

End Sub

Private Sub Application_Reminder(ByVal Item As Object)

    Dim i As Long
    Dim TotItms As Long
    Dim Fldr As MAPIFolder
    Dim ItmCnt As Long

    Set Fldr =
Me.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems)
    TotItms = Fldr.Items.Count

    If Item.Subject = "ClearEnvelope" Then
        MyNewMail Item
    ElseIf Item.Subject = "DeleteClears" Then 'this is every Sunday
        For i = TotItms To 1 Step -1
            If Fldr.Items(i).Subject = "ClearEnvelope" Then
                Fldr.Items(i).Delete
                ItmCnt = ItmCnt + 1
            End If
        Next i
        Debug.Print ItmCnt & " Items were deleted."
    End If

    Set Fldr = Nothing

End Sub

And in a standard module:

Sub MyNewMail(Itm As Object)

    If Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) _
        .UnReadItemCount = 0 Then

        RemoveNewMailIcon
    End If

    Itm.Delete

End Sub

If anyone has any comments or suggestions, I'd be happy to hear them.

Thanks
Dick Kusleika