marypolitan
New Member
- Joined
- Jan 15, 2021
- Messages
- 3
- Office Version
- 365
- Platform
- Windows
Hello, I have used this VBA code I found on this site: 2 Methods to Quickly Count Emails by Sender in Your Outlook It correctly counts items in my own inbox, but I am needing it to look at a shared inbox that I have access to and one of it's subfolders. This code is done in Outlook VBA and it creates the data in Excel. Any help on what I should add or replace is appreciated!
Sub CountInboxEmailsbySender()
Dim objDictionary As Object
Dim objInbox As Outlook.Folder
Dim i As Long
Dim objMail As Outlook.MailItem
Dim strSender As String
Dim objExcelApp As Excel.Application
Dim objExcelWorkbook As Excel.Workbook
Dim objExcelWorksheet As Excel.Worksheet
Dim varSenders As Variant
Dim varItemCounts As Variant
Dim nLastRow As Integer
Set objDictionary = CreateObject("Scripting.Dictionary")
Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
For i = objInbox.Items.Count To 1 Step -1
If objInbox.Items(i).Class = olMail Then
Set objMail = objInbox.Items(i)
strSender = objMail.SenderEmailAddress
If objDictionary.Exists(strSender) Then
objDictionary.Item(strSender) = objDictionary.Item(strSender) + 1
Else
objDictionary.Add strSender, 1
End If
End If
Next
Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Visible = True
Set objExcelWorkbook = objExcelApp.Workbooks.Add
Set objExcelWorksheet = objExcelWorkbook.Sheets(1)
With objExcelWorksheet
.Cells(1, 1) = "Sender"
.Cells(1, 2) = "Count"
End With
varSenders = objDictionary.Keys
varItemCounts = objDictionary.Items
For i = LBound(varSenders) To UBound(varSenders)
nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1
With objExcelWorksheet
.Cells(nLastRow, 1) = varSenders(i)
.Cells(nLastRow, 2) = varItemCounts(i)
End With
Next
objExcelWorksheet.Columns("A:B").AutoFit
End Sub
Sub CountInboxEmailsbySender()
Dim objDictionary As Object
Dim objInbox As Outlook.Folder
Dim i As Long
Dim objMail As Outlook.MailItem
Dim strSender As String
Dim objExcelApp As Excel.Application
Dim objExcelWorkbook As Excel.Workbook
Dim objExcelWorksheet As Excel.Worksheet
Dim varSenders As Variant
Dim varItemCounts As Variant
Dim nLastRow As Integer
Set objDictionary = CreateObject("Scripting.Dictionary")
Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
For i = objInbox.Items.Count To 1 Step -1
If objInbox.Items(i).Class = olMail Then
Set objMail = objInbox.Items(i)
strSender = objMail.SenderEmailAddress
If objDictionary.Exists(strSender) Then
objDictionary.Item(strSender) = objDictionary.Item(strSender) + 1
Else
objDictionary.Add strSender, 1
End If
End If
Next
Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Visible = True
Set objExcelWorkbook = objExcelApp.Workbooks.Add
Set objExcelWorksheet = objExcelWorkbook.Sheets(1)
With objExcelWorksheet
.Cells(1, 1) = "Sender"
.Cells(1, 2) = "Count"
End With
varSenders = objDictionary.Keys
varItemCounts = objDictionary.Items
For i = LBound(varSenders) To UBound(varSenders)
nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1
With objExcelWorksheet
.Cells(nLastRow, 1) = varSenders(i)
.Cells(nLastRow, 2) = varItemCounts(i)
End With
Next
objExcelWorksheet.Columns("A:B").AutoFit
End Sub
