vba to show total email count using SenderEmailAddress

VeryForgetful

Board Regular
Joined
Mar 1, 2015
Messages
242
Hi,

I'm looking to obtain some code that will loop through each email in my inbox and summarise the total count of emails per sender using the Outlook SenderEmailAddress property.

As well as this I am also looking for something that will loop through each email and show the total number of excel attachments that contain the word "template" in the filename and also the total number of attachments that contain picture files, note: some of the emails will have more than 1 attachment.

My inbox is huge so I would prefer if this could be done without extracting each attachment to a folder first.

I have some code that I use which lists total emails in my inbox and summarised it by date received, so not sure if I can modify this existing code to suite my needs?

Code:
Sub EmailCount()
    Dim objOutlook As Object
    Dim objnSpace As Object
    Dim objFolder As MAPIFolder
    Dim dateStr As String
    Dim myItems As Outlook.Items
    Dim dict As Object
    Dim msg As String
    Dim NextRow As Long
    Dim FirstRow As Long
    Set objOutlook = CreateObject("Outlook.Application")
    Set objnSpace = objOutlook.GetNamespace("MAPI")
    On Error Resume Next
    Set objFolder = objnSpace.Folders("Personal Folders").Folders("Inbox")
    If Err.Number <> 0 Then
        Err.Clear
        MsgBox "No such folder."
        Exit Sub
    End If
    Set dict = CreateObject("Scripting.Dictionary")
    Set myItems = objFolder.Items
    myItems.Sort "[SentOn]", True
    myItems.SetColumns "[SentOn]"
    FirstRow = 2
    ActiveSheet.Rows(FirstRow & ":" & ActiveSheet.Rows.Count).Clear
    ActiveSheet.UsedRange.Borders.LineStyle = xlNone
    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 dates that have emails
    For Each o In dict.Keys
        NextRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
        msg = o
        ActiveSheet.Range("A" & NextRow) = msg
    Next
    ' Output email count per day:
    For Each o In dict.Keys
        NextRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row + 1
        msg = dict(o)
        ActiveSheet.Range("B" & NextRow) = msg
    Next
    With ActiveSheet.Range("A1").CurrentRegion
        .HorizontalAlignment = xlCenter
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
        .Borders.ColorIndex = xlAutomatic
    End With
    
    ActiveSheet.Columns.AutoFit
End Sub
Function GetDate(dt As Date) As String
    GetDate = CDate(Day(dt) & "-" & Month(dt) & "-" & Year(dt))
End Function

Thanks
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
I now have the majority of this sorted out, but there is one additional thing I need.

I need to count the number of emails in my inbox that have picture attachments (bmp and jpeg). I can find a way to count the total number of attachments for these file types but I need to count the number of emails instead.

Any suggestions?
 
Upvote 0

Forum statistics

Threads
1,223,939
Messages
6,175,532
Members
452,651
Latest member
wordsearch

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top