How to count only unread emails? - vba

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