Solved

Outlook 2007 - Count Emails by Date

Posted on 2010-08-27
3
1,115 Views
Last Modified: 2012-05-10
Hello...I am trying to get count of emails read and unread by date.  
I have the counts..just need them by date....I have attached code.....thnks.
Sub TEST()

 

Dim objFolder As Outlook.Folder

Dim strPFPath As String

strPFPath = "myFolder_INFAV"

Set objFolder = GetPublicFolder(strPFPath)





MsgBox ("READ:  " & (objFolder.Items.count - objFolder.UnReadItemCount))

MsgBox ("UNREAD:  " & objFolder.UnReadItemCount)

MsgBox ("TOTAL:  " & objFolder.Items.count)







End Sub



Function GetPublicFolder(strPFPath)

    ' example: "Sales Department\Sales Contacts\NE Contacts"

    Dim objOL       ' As Outlook.Application

    Dim objNS       ' As Outlook.NameSpace

    Dim colFolders  ' As Outlook.Folders

    Dim objFolder   ' As Outlook.Folder

    Dim objFavRoot  ' As Outlook.Folder

    Dim arrFolders  ' As String - VBA should use arrFolders()

    Dim i           ' As Integer

    Dim j           ' As Integer

    Const olPublicFoldersAllPublicFolders = 18

    On Error Resume Next

    strPFPath = Replace(strPFPath, "/", "\")

    arrFolders = Split(strPFPath, "\")

    

     ' check Exchange online/offline status

    Set objOL = Application

    Set objNS = objOL.Session

    If objNS.Offline Then

     Else

        ' look in Public Folders\Favorites



        Set objFavRoot = GetPFFavs()

        Set colFolders = objFavRoot.Folders

        

        ' look for folder using full path

    

        ' look for folder using partial path

        If objFolder Is Nothing Then

            For i = UBound(arrFolders) To 0 Step -1

                Set colFolders = objFavRoot.Folders

                Set objFolder = Nothing

                Set objFolder = colFolders.Item(arrFolders(i))

                If Not objFolder Is Nothing Then

                    If i = UBound(arrFolders) Then

                        Exit For

                    Else

                        j = i

                        Do While j <= UBound(arrFolders)

                            j = j + 1

                            Set colFolders = objFolder.Folders

                            Set objFolder = Nothing

                            Set objFolder = _

                              colFolders.Item(arrFolders(j))

                            If Not objFolder Is Nothing Then

                                If j = UBound(arrFolders) Then

                                    Exit Do

                                End If

                            Else

                                Exit Do

                            End If

                        Loop

                        If Not objFolder Is Nothing Then

                            Exit For

                        End If

                    End If

                End If

            Next

        End If

    End If

    

    

    

    Set GetPublicFolder = objFolder

    Set objOL = Nothing

    Set objNS = Nothing

    Set colFolders = Nothing

    Set objFolder = Nothing

End Function



Function GetPFFavs()

    ' returns localized Public Folders\Favorites

    Dim objOL      ' As Outlook.Application

    Dim objNS      ' As Outlook.NameSpace

    Dim colFolders ' As Outlook.Folders

    Dim objFolder  ' As Outlook.Folder

    Dim objAllPF   ' As Outlook.Folder

    Dim objStore   ' As Outlook.Store

    Dim blnPFFound ' As Boolean

    Const olExchangePublicFolder = 2

    Const olPublicFoldersAllPublicFolders = 18

    On Error Resume Next

    Set objOL = Application

    Set objNS = objOL.Session

    For Each objStore In objNS.Stores

        If objStore.ExchangeStoreType = _

          olExchangePublicFolder Then

            blnPFFound = True

            Exit For

        End If

    Next

    If blnPFFound Then

        Set objFolder = objStore.GetRootFolder

        If objFolder.Folders.count = 1 Then

            Set GetPFFavs = objFolder.Folders.Item(1)

        Else

            Set objAllPF = objNS.GetDefaultFolder _

                            (olPublicFoldersAllPublicFolders)

            If objAllPF Is Nothing Then

                Set objFolder = objFolder.Folders.Item(1)

                If objFolder Is Nothing Then

                    Set objFolder = objFolder.Folders.Item(1)

                End If

                Set GetPFFavs = objFolder

            Else

                If objFolder.Folders.Item(1).EntryID = _

                  objAllPF.EntryID Then

                    Set GetPFFavs = objFolder.Folders.Item(2)

                Else

                    Set GetPFFavs = objFolder.Folders.Item(1)

                End If

            End If

        End If

    End If

    Set objOL = Nothing

    Set objNS = Nothing

    Set colFolders = Nothing

    Set objFolder = Nothing

    Set objAllPF = Nothing

    Set objStore = Nothing

End Function

Open in new window

0
Comment
Question by:TechMonster
  • 2
3 Comments
 
LVL 76

Accepted Solution

by:
David Lee earned 500 total points
ID: 33550740
Hi, TechMoster.

This should do it.
Dim dicRead As Object, dicUnread As Object, objFolder As Object, objItems As Outlook.Items, objItem As Outlook.MailItem, strDate As String, intCount As Integer, strPFPath As String
Dim arrReadValues As Variant, arrReadKeys As Variant, strRead As String
Dim arrUnreadValues As Variant, arrUnreadKeys As Variant, strUnread As String
Set dicRead = CreateObject("Scripting.Dictionary")
Set dicUnread = CreateObject("Scripting.Dictionary")
strPFPath = "myFolder_INFAV"
Set objFolder = GetPublicFolder(strPFPath)
Set objItems = objFolder.Items
objItems.Sort "ReceivedTime"
For Each objItem In objFolder.Items
    strDate = Format(objItem.ReceivedTime, "mm/dd/yyyy")
    Select Case objItem.UnRead
        Case True
            If dicRead.Exists(strDate) Then
                dicRead.Item(strDate) = dicRead.Item(strDate) + 1
            Else
                dicRead.Add strDate, 1
            End If
        Case False
            If dicUnread.Exists(strDate) Then
                dicUnread.Item(strDate) = dicUnread.Item(strDate) + 1
            Else
                dicUnread.Add strDate, 1
            End If
    End Select
Next
arrReadValues = dicRead.Items()
arrReadKeys = dicRead.keys()
For intCount = LBound(arrReadKeys) To UBound(arrReadKeys)
    strRead = strRead & arrReadKeys(intCount) & " = " & arrReadValues(intCount) & vbCrLf
Next
msgbox strRead, vbInformation + vbOKOnly, "Read Message Count"
arrUnreadValues = dicUnread.Items()
arrUnreadKeys = dicUnread.keys()
For intCount = LBound(arrUnreadKeys) To UBound(arrUnreadKeys)
    strUnread = strUnread & arrUnreadKeys(intCount) & " = " & arrUnreadValues(intCount) & vbCrLf
Next
msgbox strUnread, vbInformation + vbOKOnly, "Unread Message Count"
Set dicRead = Nothing
Set dicUnread = Nothing
Set objFolder = Nothing
Set objItems = Nothing
Set objItem = Nothing

Open in new window

0
 

Author Comment

by:TechMonster
ID: 33559556
This was a lot of help.  I was actually able to get the count of emails by day but was not able to figure out how to get the read and unread by date....appreciate it much.  thanks.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 33562842
You're welcome.
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Find out how to use dynamic social media in email signatures with this top 10 DOs & DON’Ts.
Create high volume marketing opportunities using email signatures with these top 10 DOs and DON'Ts of email signature marketing.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now