Outlook categories count for Shared Mailbox

[cdlane]

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

[skatonni]

Sub CategoriesByStore()
 
    Dim colStores As Stores
    Dim oStore As store
    Dim objCategories As Categories
    Dim objCategory As Category
    Dim i As Long
    
    Set colStores = Session.Stores
    
    ' Debug.Print "colStores.count: " & colStores.count
    
    For i = 1 To colStores.count
    
        Set oStore = colStores(i)
        Debug.Print "Store " & i & ": " & oStore
        
        If oStore = "store name from immediate window" Then
        
            Set objCategories = oStore.Categories
            For Each objCategory In objCategories
                Debug.Print objCategory
            Next
        
            Exit For
            
        End If
        
    Next
 
End Sub