Displaying Outlook categories for a shared Inbox

[GarrickB]

Hello,

I'm using Outlook 2013 and trying to make a VBA script that outputs how many messages are in each category for an input date range. I need to be able to use the script on a shared inbox that is added to my personal inbox as an "Additional Mailbox", however right now it will only work on my personal inbox. How would I modify this to output for the shared inbox instead? Also, what would I need to do to make it include the sub-folders of the shared inbox? I've experimented with different methods I've found in past posts, however I'm not experienced enough with VBA scripting to get it working properly. The code I have is below:

Sub CategoriesEmails()

Dim oFolder As MAPIFolder
Dim oDict As Object
Dim sStartDate As String
Dim sEndDate As String
Dim oItems As Outlook.Items
Dim sStr As String
Dim sMsg As String
 
 
On Error Resume Next
Set oFolder = Application.ActiveExplorer.CurrentFolder
 
Set oDict = CreateObject("Scripting.Dictionary")
 
sStartDate = InputBox("Type the start date (format MM/DD/YYYY)")
sEndDate = InputBox("Type the end date (format MM/DD/YYYY)")
 
Set oItems = oFolder.Items.Restrict("[Received] >= '" & sStartDate & "' And [Received] <= '" & sEndDate & "'")
oItems.SetColumns ("Categories")
 
For Each aitem In oItems
sStr = aitem.Categories
If Not oDict.Exists(sStr) Then
oDict(sStr) = 0
End If
oDict(sStr) = CLng(oDict(sStr)) + 1
Next aitem
 
sMsg = ""
For Each aKey In oDict.Keys
sMsg = sMsg & aKey & ":   " & oDict(aKey) & vbCrLf
Next
MsgBox sMsg
 
Set oFolder = Nothing
 
End Sub

It would be particularly useful if I could export this data to Excel and display categories by folders, however if this is difficult I don't want to complicate things further.

Any help or suggestions would be very appreciated!

 

[SkipVought]

Hi,

If it were me, and the last time I checked, it was, I'd run your Outlook code from Excel. Check it out: your code will run in Excel VBA. You will need to add a reference to the Microsoft Outlook m.n Object Library. Mine is the Outlook 15.0 Object Library.

From there, it's quite simple to write the values in your array into the cells on a sheet, for instance...

Dim lRow as Long

lRow = 2
For Each aKey In oDict.Keys
   cells(lRow, 1).Value =  oDict(aKey) 
   lRow = lRow + 1
Next

Your Start and End dates could be entered on the sheet and a button to kick the process off.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[GarrickB]

Hello,

Thanks for the advice. I might give that a try. Honestly my VBA scripting knowledge is so weak I'm worried about changing much, but that does seem like a better implementation. If I can get a version that can read my shared mailbox to work in the meantime, I'll have more room to optimize.