I am trying to implement a solution created by Sue Mosher on how to
keep a count of the number of emails that I get on a daily basis.  I
have gotten this to work on my Outlook at home, but can't seem to get
it to work at the office.  I'm using Outlook 2003.  Here is the code
that I've Used.  I can manually run the UpdateCounter VBA, and it
creates the record, but I can't get it to work when mail is actually
received.  Anyone have any suggestions on what I need to do?

VBA in "This Outlook Session"

Option Explicit

Private WithEvents olInboxItems As Items

Private Sub Application_Startup()
   Dim objNS As NameSpace

   Set objNS = Application.GetNamespace("MAPI")
   Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items

   Set objNS = Nothing
End Sub

Private Sub Application_Quit()
   'disassociate global objects
   Set olInboxItems = Nothing
End Sub

Private Sub olInboxItems_Itemsadd(ByVal Item As Object)
   If Item.Class = olMail Then
       Call UpdateCounter
   End If
End Sub

Sub UpdateCounter()
   Dim objApp As Application
   Dim objNS As NameSpace
   Dim objInbox As MAPIFolder
   Dim objMessageCountFolder As MAPIFolder
   Dim objTodayCount As PostItem
   Dim strNow As String
   Dim strFind As String

   Set objApp = CreateObject("Outlook.Application")
   Set objNS = objApp.GetNamespace("MAPI")
   Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
   Set objMessageCountFolder = objInbox.Folders("Message Count")

   If Not objMessageCountFolder Is Nothing Then
       ' get the item that matches today
       strNow = FormatDateTime(Now, vbLongDate)
       strFind = "[Subject] = """ & strNow & """"
       Set objTodayCount = objMessageCountFolder.Items.Find(strFind)
       If objTodayCount Is Nothing Then
           ' create a new item
           Set objTodayCount = _
               objMessageCountFolder.Items.Add("IPM.Post")
           objTodayCount.Subject = strNow
           objTodayCount.Mileage = 1
       Else
           objTodayCount.Mileage = CInt(objTodayCount.Mileage) + 1
       End If
       objTodayCount.Save

   End If

   Set objTodayCount = Nothing
   Set objMessageCountFolder = Nothing
   Set objInbox = Nothing
   Set objNS = Nothing
   Set objApp = Nothing
End Sub

VBA in Module

Sub UpdateCounter()
   Dim objApp As Application
   Dim objNS As NameSpace
   Dim objInbox As MAPIFolder
   Dim objMessageCountFolder As MAPIFolder
   Dim objTodayCount As PostItem
   Dim strNow As String
   Dim strFind As String

   Set objApp = CreateObject("Outlook.Application")
   Set objNS = objApp.GetNamespace("MAPI")
   Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
   Set objMessageCountFolder = objInbox.Folders("Message Count")

   If Not objMessageCountFolder Is Nothing Then
       ' get the item that matches today
       strNow = FormatDateTime(Now, vbLongDate)
       strFind = "[Subject] = """ & strNow & """"
       Set objTodayCount = objMessageCountFolder.Items.Find(strFind)
       If objTodayCount Is Nothing Then
           ' create a new item
           Set objTodayCount = _
               objMessageCountFolder.Items.Add("IPM.Post")
           objTodayCount.Subject = strNow
           objTodayCount.Mileage = 1
       Else
           objTodayCount.Mileage = CInt(objTodayCount.Mileage) + 1
       End If
       objTodayCount.Save

   End If

   Set objTodayCount = Nothing
   Set objMessageCountFolder = Nothing
   Set objInbox = Nothing
   Set objNS = Nothing
   Set objApp = Nothing
End Sub