I am trying to get the count of the number of items associated with a category on a Shared Mailbox that is linked to my Outlook account. All code that i have found only references the actual Outlook categories and i am not sure how to set the item to look at the shared mailbox to get the categories to count. I beleive the issue is the code in Bolded Green below, but can't find a property to reference the Shared Mailbox.
I have adjusted this code a little to meet my needs, but it was written by Shirley Zhang:
Public objDictionary As Object
Public objExcelApp As Excel.Application
Public objExcelWorkbook As Excel.Workbook
Public objExcelWorksheet As Excel.Worksheet
Sub ExportCountofItemsinEachColorCategories()
Dim objCategories As Object
Dim objCategory As Object
Dim objPSTFile As Outlook.Folder
Dim objFolder As Outlook.Folder
Dim strExcelFile As String
'Create a New Excel file
Set objExcelApp = CreateObject("Excel.Application")
Set objExcelWorkbook = objExcelApp.Workbooks.Add
Set objExcelWorksheet = objExcelWorkbook.Sheets("Sheet1")
objExcelWorksheet.Cells(1, 1) = "Color Category"
objExcelWorksheet.Cells(1, 2) = "Count"
'Find all the color categories
Set objDictionary = CreateObject("Scripting.Dictionary")
Set objCategories = Outlook.Application.Session.Categories
For Each objCategory In objCategories
objDictionary.Add objCategory.Name, 0
Next
Set objPSTFile = Outlook.Application.Session.PickFolder
For Each objFolder In objPSTFile.Folders
ProcessFolder objFolder
Next
'Save the new Excel file
objExcelWorksheet.Columns("A:B").AutoFit
strExcelFile = "C:\Users\cdlane\Documents\Color Categories (" & Format(Now, "yyyy-mm-dd_hh-mm-ss") & ").xlsx"
objExcelWorkbook.Close True, strExcelFile
MsgBox "Complete!", vbExclamation
End Sub
Private Sub ProcessFolder(ByVal objCurrentFolder As Outlook.Folder)
Dim objItem As Object
Dim objSubFolder As Object
Dim ArrayCategories As Variant
Dim VarCategory As Variant
Dim ArrayKey As Variant
Dim ArrayItem As Variant
Dim i As Long
Dim nRow As Integer
'Count the items in each color category via Dictionary object
For Each objItem In objCurrentFolder.Items
If objItem.Categories <> "" Then
ArrayCategories = Split(objItem.Categories, ",")
For Each VarCategory In ArrayCategories
If objDictionary.Exists(VarCategory) = True Then
objDictionary.Item(VarCategory) = objDictionary.Item(VarCategory) + 1
End If
Next
End If
Next
ArrayKey = objDictionary.Keys
ArrayItem = objDictionary.Items
nRow = 2
'Input the information into the new Excel file
For i = LBound(ArrayKey) To UBound(ArrayKey)
objExcelWorksheet.Cells(nRow, 1) = ArrayKey(i)
objExcelWorksheet.Cells(nRow, 2) = ArrayItem(i)
nRow = nRow + 1
Next
'Process the subfolders recursively
For Each objSubFolder In objCurrentFolder.Folders
ProcessFolder objSubFolder
Next
End Sub