CODEWITHSUNDEEP
vbaoutlookms-office
Shaik
Shaik

Reputation: 11

Count Read and Unread Emails date wise for shared mailbox

I have edited VBA which I found in Stack Overflow to suit my needs.

It gives me the count of emails of my default inbox date wise and count of unread emails without dates.

I need it to count the emails of my shared mailbox. For example Redstreamattmail and not the default mailbox, DATE WISE for overall emails and unread emails.

Sub HowManyEmails()    

Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder    
Dim EmailCount As Integer    

Dim a As Outlook.Application    
Dim b As Outlook.NameSpace    
Dim c As Outlook.MAPIFolder    

Set a = New Outlook.Application    
Set b = a.GetNamespace("MAPI")    
Set c = b.GetDefaultFolder(olFolderInbox)    
d = c.UnReadItemCount    

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

On Error Resume Next    

Set objFolder = objnSpace.GetDefaultFolder(olFolderInbox)    

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

EmailCount = objFolder.Items.Count    

MsgBox "Number of emails in the folder: " & EmailCount & " Total Unread     email count are   " & d    

Dim dateStr As String    
Dim myItems As Outlook.Items    
Dim dict As Object    
Dim msg, msg1 As String    

Set dict = CreateObject("Scripting.Dictionary")    
Set myItems = objFolder.Items    

myItems.SetColumns ("SentOn")    

' Determine date of each message:    

For Each myItem In myItems    
    dateStr = GetDate(myItem.SentOn)    
    If Not dict.Exists(dateStr) Then    
        dict(dateStr) = 0    
    End If    
    dict(dateStr) = CLng(dict(dateStr)) + 1    
Next myItem    

' Output counts per day:    
For Each o In dict.Keys    
    msg = msg & o & ":    " & dict(o) & " Email items" & vbCrLf    
Next    
msg1 = "unread Emails are        " & d    

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

'Send Email    
Set OutApp = CreateObject("outlook.Application")    
Set OutMail = OutApp.CreateItem(o)    

With OutMail    
    .Subject = "Count of emails"    
    .To = "[email protected];"    
    .Body = msg & msg1    
    .Display    
    '.Send    
End With     

Set OutMail = Nothing    
Set OutApp = Nothing    

End Sub

Upvotes: 1

Views: 1959

Answers (1)

OpiesDad
OpiesDad

Reputation: 3435

Try:

Set c =  b.Folders("Name of shared mailbox")

Where you put the correct folder name in there.

Upvotes: 1

Related Questions