Dear All,
I am trying to count how many unread and read emails are in each sub folder within my Inbox in Microsoft Outlook, I am having difficulty adding the search each folder part into the coding below, the coding currently lets me choose the folder and then counts the emails for me, I want to be able to automatically just tell me that there are 10 unread in inbox, and 2 read, 4 unread, 5 read in useful files(subfolder of inbox) and so on until all subfolders in the inbox have been checked.the data is then stored on a SS.
Coding
Sub CountEmails()
Dim objApp As Object
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Dim objItem As MailItem
Dim unreadm As Integer
Dim readm As Integer
Dim fldset As MAPIFolder
Set objApp = CreateObject("Outlook.Application"![Wink ;) ;)](data:image/gif;base64,R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7)
Set objNS = objApp.GetNamespace("MAPI"![Wink ;) ;)](data:image/gif;base64,R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7)
Set objFolder = objNS.PickFolder
For I = 1 To objFolder.Items.Count
If Err = 0 Then
Set objItem = objFolder.Items(I)
If objItem.UnRead Then
unreadm = unreadm + 1
Else
readm = readm + 1
End If
Err.Clear
End If
Next I
[c2].Value = unreadm
[c3].Value = readm
End Sub
I would really appreciate any help on this, as it is proving very frustrating.
Thanks Rob.![[yoda] [yoda] [yoda]](/data/assets/smilies/yoda.gif)
I am trying to count how many unread and read emails are in each sub folder within my Inbox in Microsoft Outlook, I am having difficulty adding the search each folder part into the coding below, the coding currently lets me choose the folder and then counts the emails for me, I want to be able to automatically just tell me that there are 10 unread in inbox, and 2 read, 4 unread, 5 read in useful files(subfolder of inbox) and so on until all subfolders in the inbox have been checked.the data is then stored on a SS.
Coding
Sub CountEmails()
Dim objApp As Object
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Dim objItem As MailItem
Dim unreadm As Integer
Dim readm As Integer
Dim fldset As MAPIFolder
Set objApp = CreateObject("Outlook.Application"
Set objNS = objApp.GetNamespace("MAPI"
Set objFolder = objNS.PickFolder
For I = 1 To objFolder.Items.Count
If Err = 0 Then
Set objItem = objFolder.Items(I)
If objItem.UnRead Then
unreadm = unreadm + 1
Else
readm = readm + 1
End If
Err.Clear
End If
Next I
[c2].Value = unreadm
[c3].Value = readm
End Sub
I would really appreciate any help on this, as it is proving very frustrating.
Thanks Rob.
![[yoda] [yoda] [yoda]](/data/assets/smilies/yoda.gif)