How to count only unread emails?

Question

I am using the following vba code in outlook to count all the emails in a folder and subfolders. But I want to edit my code so that it only counts the unread emails.

Is there a way I can do this and if so would someone please be able to show me how?

Sub HowManyEmails()

    Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder
    Dim objFolder2 As MAPIFolder
    Dim objFolder3 As MAPIFolder
    Dim objFolder4 As MAPIFolder
    Dim objFolder5 As MAPIFolder
    Dim objFolder6 As MAPIFolder
    Dim objFolder7 As MAPIFolder
    Dim objFolder8 As MAPIFolder
    Dim objFolder9 As MAPIFolder
    Dim objFolder10 As MAPIFolder
    Dim objFolder11 As MAPIFolder
    Dim objFolder12 As MAPIFolder
    Dim objFolder13 As MAPIFolder
    Dim objFolder14 As MAPIFolder
    Dim EmailCount As Integer
    Set objOutlook = CreateObject("Outlook.Application")
    Set objnSpace = objOutlook.GetNamespace("MAPI")

    On Error Resume Next

    Set objFolder = objnSpace.Folders("Purchasing").Folders("Inbox").Folders("Suppliers").Folders("3PL & HAULAGE")
    Set objFolder2 = objnSpace.Folders("Purchasing").Folders("Inbox").Folders("Suppliers").Folders("ACCOMODATION")
    Set objFolder3 = objnSpace.Folders("Purchasing").Folders("Inbox").Folders("Suppliers").Folders("CORE FLEET & EQUIPMENT")
    Set objFolder4 = objnSpace.Folders("Purchasing").Folders("Inbox").Folders("Suppliers").Folders("LUBRICANTS & OILS")
    Set objFolder5 = objnSpace.Folders("Purchasing").Folders("Inbox").Folders("Suppliers").Folders("MARKETING")
    Set objFolder6 = objnSpace.Folders("Purchasing").Folders("Inbox").Folders("Suppliers").Folders("PLANT EQUIPMENT & TOOLS")
    Set objFolder7 = objnSpace.Folders("Purchasing").Folders("Inbox").Folders("Suppliers").Folders("PROPERTY & REFURBISHMENT")
    Set objFolder8 = objnSpace.Folders("Purchasing").Folders("Inbox").Folders("Suppliers").Folders("SECURITY & SYSTEMS")
    Set objFolder9 = objnSpace.Folders("Purchasing").Folders("Inbox").Folders("Suppliers").Folders("SERVICING & REPAIRS")
    Set objFolder10 = objnSpace.Folders("Purchasing").Folders("Inbox").Folders("Suppliers").Folders("STATIONARY")
    Set objFolder11 = objnSpace.Folders("Purchasing").Folders("Inbox").Folders("Suppliers").Folders("TESTING & CALIBRATING")
    Set objFolder12 = objnSpace.Folders("Purchasing").Folders("Inbox").Folders("Suppliers").Folders("UTILITIES: GAS, FUEL, ELECTRICAL (ENERGY)")
    Set objFolder13 = objnSpace.Folders("Purchasing").Folders("Inbox").Folders("Suppliers").Folders("X-HIRE CRANE HIRE")
    Set objFolder14 = objnSpace.Folders("Purchasing").Folders("Inbox").Folders("Suppliers").Folders("X-HIRE PLANT EQUIPMENT")


    If Err.Number <> 0 Then
        Err.Clear
        MsgBox "No such folder."
        Exit Sub
    End If

    EmailCount = objFolder.Items.Count
    EmailCount2 = objFolder2.Items.Count
    EmailCount3 = objFolder3.Items.Count
    EmailCount4 = objFolder4.Items.Count
    EmailCount5 = objFolder5.Items.Count
    EmailCount6 = objFolder6.Items.Count
    EmailCount7 = objFolder7.Items.Count
    EmailCount8 = objFolder8.Items.Count
    EmailCount9 = objFolder9.Items.Count
    EmailCount10 = objFolder10.Items.Count
    EmailCount11 = objFolder11.Items.Count
    EmailCount12 = objFolder12.Items.Count
    EmailCount13 = objFolder13.Items.Count
    EmailCount14 = objFolder14.Items.Count

    MsgBox "New Suppliers & New Business Report Sent"

    TempFilePath = "\\UKSH000-File06\Purchasing\New_Supplier_Set_Ups_&_Audits\assets\"

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "<p style='color:#000;font-family:calibri;font-size:16'>Dear Jason," & vbNewLine & vbNewLine & _
              "<br><br>" & "This is your weekly report, for " & "<b>" & "New Suppliers & New Business Introductions" & "</b>" & ", sent to you from NewSuppliers." & vbNewLine & _
              "<br>" & "Please see a breakdown of different types of suppliers and new business below:" & vbNewLine & vbNewLine & _
              "<br><br><br>" & "3PL & HAULAGE SUPPLIERS: " & " " & "<font size=""4.5"" face=""calibri"" color=""red"">" & "<b>" & EmailCount & "</b></font>" & vbNewLine & _
              "<br>" & "ACCOMODATION SUPPLIERS: " & " " & "<font size=""4.5"" face=""calibri"" color=""red"">" & "<b>" & EmailCount2 & "</b></font>" & vbNewLine & _
              "<br>" & "CORE FLEET & EQUIPMENT SUPPLIERS: " & " " & "<font size=""4.5"" face=""calibri"" color=""red"">" & "<b>" & EmailCount3 & "</b></font>" & vbNewLine & _
              "<br>" & "LUBRICANT & OILS SUPPLIERS: " & " " & "<font size=""4.5"" face=""calibri"" color=""red"">" & "<b>" & EmailCount4 & "</b></font>" & vbNewLine & _
              "<br>" & "MARKETING SUPPLIERS: " & " " & "<font size=""4.5"" face=""calibri"" color=""red"">" & "<b>" & EmailCount5 & "</b></font>" & vbNewLine & _
              "<br>" & "PLANT EQUIPMENT & TOOLS SUPPLIERS: " & " " & "<font size=""4.5"" face=""calibri"" color=""red"">" & "<b>" & EmailCount6 & "</b></font>" & vbNewLine & _
              "<br>" & "PROPERTY & REFURBISHMENT SUPPLIERS: " & " " & "<font size=""4.5"" face=""calibri"" color=""red"">" & "<b>" & EmailCount7 & "</b></font>" & vbNewLine & _
              "<br>" & "SECURITY & SYSTEMS SUPPLIERS: " & " " & "<font size=""4.5"" face=""calibri"" color=""red"">" & "<b>" & EmailCount8 & "</b></font>" & vbNewLine & _
              "<br>" & "SERVICING & REPAIRS SUPPLIERS: " & " " & "<font size=""4.5"" face=""calibri"" color=""red"">" & "<b>" & EmailCount9 & "</b></font>" & vbNewLine & _
              "<br>" & "STATIONARY SUPPLIERS: " & " " & "<font size=""4.5"" face=""calibri"" color=""red"">" & "<b>" & EmailCount10 & "</b></font>" & vbNewLine & _
              "<br>" & "TESTING & CALIBRATING SUPPLIERS: " & " " & "<font size=""4.5"" face=""calibri"" color=""red"">" & "<b>" & EmailCount11 & "</b></font>" & vbNewLine & _
              "<br>" & "UTILITIES & ENERGY SUPPLIERS: " & " " & "<font size=""4.5"" face=""calibri"" color=""red"">" & "<b>" & EmailCount12 & "</b></font>" & vbNewLine & _
              "<br>" & "X-HIRE CRANE SUPPLIERS: " & " " & "<font size=""4.5"" face=""calibri"" color=""red"">" & "<b>" & EmailCount13 & "</b></font>" & vbNewLine & _
              "<br>" & "X-HIRE PLANT SUPPLIERS: " & " " & "<font size=""4.5"" face=""calibri"" color=""red"">" & "<b>" & EmailCount14 & "</b></font>" & vbNewLine & _
              "<br><br><br>" & "If you have any queries please reply to this email, NewSuppliers@Hewden.co.uk." & vbNewLine & vbNewLine & _
              "<br><br>" & "Kind Regards," & "</font></p>" & vbNewLine & _
              "<p style='color:#000;font-family:calibri;font-size:18'><b>Automated Purchasing Email</font></p></b>" & vbNewLine & _
              "<br><br><img src='cid:cover.jpg'" & "width='800' height='64'><br>" & vbNewLine & _
              "<img src='cid:subs.jpg'" & "width='274' height='51'>"



    With OutMail
        .SentOnBehalfOfName = "newsuppliers@hewden.co.uk"
        .To = "mark.o'brien@hewden.co.uk"
        .CC = ""
        .BCC = ""
        .Subject = "New Suppliers & New Business Introduction - Weekly Report"
        .HtmlBody = strbody
        .Attachments.Add TempFilePath & "cover.jpg", olByValue, 0
        .Attachments.Add TempFilePath & "subs.jpg", olByValue, 0
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With

    Dim dateStr As String
    Dim myItems As Outlook.Items
    Dim dict As Object
    Dim msg As String
    Set dict = CreateObject("Scripting.Dictionary")
    Set myItems = objFolder.Items
    myItems.SetColumns ("ReceivedTime")
    ' Determine date of each message:
    For Each myItem In myItems
        dateStr = GetDate(myItem.ReceivedTime)
        If Not dict.Exists(dateStr) Then
            dict(dateStr) = 0
        End If
        dict(dateStr) = CLng(dict(dateStr)) + 1
    Next myItem

    ' Output counts per day:
    msg = ""
    For Each o In dict.Keys
        msg = msg & o & ": " & dict(o) & " items" & vbCrLf
    Next

    Dim fso As Object
    Dim fo As Object

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fo = fso.CreateTextFile("C:\Users\x152833\outlook_log.txt")
    fo.Write msg
    fo.Close

    Set fo = Nothing
    Set fso = Nothing
    Set objFolder = Nothing
    Set objnSpace = Nothing
    Set objOutlook = Nothing
End Sub

Answer 1

You can use

unreadCount = myItems.Restrict("[Unread] = true").Count

You can also try to read the PR_CONTENT_UNREAD MAPI property (DASL name "http://schemas.microsoft.com/mapi/proptag/0x36030003") using MAPIFolder.PropertyAccessor.GetProperty (the property is not guaranteed to be present). If the property is not present, you can catch the exception and fall back to Items.Restrict, which always works, but is a lot less efficient than PR_CONTENT_UNREAD.

Take a look at the folder with OutlookSpy (I am its author - click IMAPIFolder button) to check if PR_CONTENT_UNREAD property is available in your particular case.

Answer 2

It turned out to be quite easy, all you have to do is iterate through the Items collection of your objfolder objects and check the UnRead property of the items like this:

For Each i In objFolder.items

    If (i.UnRead) Then

        EmailCount = EmailCount + 1

    End If

Next

However, I highly recommend getting rid of all those variables named objFolderxy and EmailCountxy. There is a much better way to do this. Consider the following example:

Sub GetFolderStats()

Dim objOutlook As Object, objnSpace As Object, objFolder As Object

Dim d
Set d = CreateObject("Scripting.Dictionary")

Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")

Set objFolder = objnSpace.Folders("Mailbox - CENSORED").Folders("Inbox").Folders("Suppliers")

For Each folder In objFolder.Folders

    emailcount = 0

    For Each i In folder.items

        If (i.UnRead) Then

            emailcount = emailcount + 1

        End If

    Next

    d.Add folder.Name, emailcount

Next

Set d = Nothing
Set objOutlook = Nothing
Set objnSpace = Nothing
Set objFolder = Nothing

End Sub

Now, you might not need the dictionary at all, just wanted to give you an example how you could iterate through the email folders instead of explicitly specifying their names.

Of course, instead of storing these data in the dictionary, you could create the html markup on-the-fly thus there would be no need to process the dictionary saving a for loop.

Hope I could help...