I find the below online and it does exactly what i need however it only goes to my personal inbox, i have multiply access to different inboxes and want to run it for each, can someone amend this so i can just put my email destination, i also want it to run through all subfolders not just the inbox

Option Explicit
Sub test()
Dim oDict As Scripting.Dictionary
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olItem As Object
Dim arrData() As Variant
Dim CategoryCnt As Integer
Dim c As Long

Set oDict = New Scripting.Dictionary

Set olApp = New Outlook.Application

Set olNS = olApp.GetNamespace("MAPI")

Set olFolder = olNS.GetDefaultFolder(olFolderInbox)

CategoryCnt = olNS.Categories.Count

ReDim arrData(1 To 2, 1 To CategoryCnt)

c = 0
For Each olItem In olFolder.Items
If Not oDict.Exists(olItem.Categories) Then
c = c + 1
arrData(1, c) = olItem.Categories
arrData(2, c) = 1
oDict.Add olItem.Categories, c
Else
arrData(2, oDict.Item(olItem.Categories)) = arrData(2, oDict.Item(olItem.Categories)) + 1
End If
Next olItem

ReDim Preserve arrData(1 To 2, 1 To c)

Range("A2").Resize(UBound(arrData, 2), UBound(arrData, 1)).Value = Application.Transpose(arrData)

End Sub