Sum all email.Items from Inbox + subfolders

Question

Goodafternoon,

I am populating an list box with all the emails from Inbox + Subfolders, via Table object. This is working fine.

Then, with Doubleclick events from ListBox1, I am trying to open the email that is been selected. If the loop is going only through Inbox folder, it is going correct. But when I'm trying to loop through SubFolders from Inbox, it is not going. So I am trying to collect(sum) all the emails from Inbox + subfolder in one:

Set InboxItems = SubFolder.Items

But offcorse it is not working. What can be done?

my code:

Option Explicit

    Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    
        Dim objNS As Outlook.namespace: Set objNS = GetNamespace("MAPI")
        Dim oFolder As Outlook.MAPIFolder: Set oFolder = objNS.GetDefaultFolder(olFolderInbox)
    
    
        Dim i As Long
        Dim j As Long
        Dim InboxItems As Outlook.Items
        
        Dim thisEmail As Outlook.MailItem
        Dim SubFolder As Outlook.MAPIFolder
        Dim myArray() As String
        
        
        
        Dim Folders         As New Collection
        Dim entryID         As New Collection
        Dim StoreID         As New Collection
    
    
        Call GetFolder(Folders, entryID, StoreID, oFolder)
        myArray = ConvertToArray(indexEmailInbox)
        
        For j = 1 To Folders.Count
            Set SubFolder = Application.Session.GetFolderFromID(entryID(j), StoreID(j))
            Set InboxItems = SubFolder.Items
        Next
        
         
    
    
            For i = LBound(myArray) To UBound(myArray)
                If Me.ListBox1.Selected(i) = True Then
                    If TypeName(InboxItems.Item(onlyDigits(myArray(i)))) = "MailItem" Then ' it's an email
    
                        'MsgBox onlyDigits(myArray(UBound(myArray) - i - 1))
                        Set thisEmail = InboxItems.Item(onlyDigits(myArray(UBound(myArray) - i - 1)))
                        Unload Me
                        thisEmail.Display
                        Exit Sub
                    End If
                End If
            Next i
        
    
    End Sub


Function ConvertToArray(ByVal value As String)
    value = StrConv(value, vbUnicode)
    ConvertToArray = Split(Left(value, Len(value) - 1), "§")
End Function

Sub GetFolder(folders As Collection, entryID As Collection, StoreID As Collection, fld As MAPIFolder)

Dim SubFolder       As MAPIFolder

    folders.Add fld.FolderPath
    entryID.Add fld.entryID
    StoreID.Add fld.StoreID
    For Each SubFolder In fld.folders
        GetFolder folders, entryID, StoreID, SubFolder
    Next SubFolder
    
ExitSub:

    Set SubFolder = Nothing

End Sub

[Edit](https://stackoverflow.com/posts/68019068/edit) the question to put in code for `GetFolder` and `ConvertToArray`. [mcve]. Put `Option Explicit` at the top. — niton, Jun 18 '21 at 21:07

niton · Answer 1 · 2021-06-21T21:10:26.767

You may .Add items to a collection one at a time.

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant

Private Sub collection_Emails_Folder_And_Subfolders()
    
    Dim objFolder As folder
    Dim myItemsCol As New Collection
    Dim i As Long
    
    Dim myItems As Items
    
    Set objFolder = Session.PickFolder
    
    If objFolder Is Nothing Then
        Exit Sub
    End If
    
    'Set objFolder = Session.GetDefaultFolder(olFolderInbox)
    
    processFolder objFolder, myItemsCol
    
    ' Methods available are limited to:
    '  Add, Count, Item and Remove
    Debug.Print vbCr & "Final total - myItemsCol.Count: " & myItemsCol.Count
    
    ' You may access item properties
    For i = 1 To myItemsCol.Count
        Debug.Print " " & i & ": " & myItemsCol(i).ReceivedTime, myItemsCol(i).subject
    Next i
    
End Sub


Private Sub processFolder(ByVal objFolder As folder, ByVal myItemsCol As Collection)

    ' https://stackoverflow.com/questions/2272361/can-i-iterate-through-all-outlook-emails-in-a-folder-including-sub-folders

    Dim EmailCount As Long
    
    Dim myItem As Object
    Dim myItems As Items
    
    Dim i As Long
    
    Dim oFolder As folder
    
    Debug.Print vbCr & "objFolder: " & objFolder
    
    EmailCount = objFolder.Items.Count
    Debug.Print " EmailCount...: " & EmailCount
    
    If EmailCount > 0 Then
        
        Set myItems = objFolder.Items
        myItems.Sort "[ReceivedTime]", False ' oldest to newest
        
        For i = 1 To myItems.Count
            'Debug.Print " " & i & ": " & myItems(i).ReceivedTime, myItems(i).subject
            myItemsCol.Add myItems(i)
        Next
                
    End If
    
    Debug.Print " Running total: " & myItemsCol.Count
    
    If (objFolder.Folders.Count > 0) Then
        For Each oFolder In objFolder.Folders
            processFolder oFolder, myItemsCol
        Next
    End If
        
End Sub

You should be able to replace InboxItems with myItemsCol.

If TypeName(myItemsCol.Item((onlyDigits(myArray(i)))) = "MailItem" Then ' it's an email

Set thisEmail = myItemsCol.Item(onlyDigits(myArray(UBound(myArray) - i - 1)))

This is what I was trying to do, but without success. Respect! — white_flag, Jun 22 '21 at 10:48

Eugene Astafiev · Answer 2 · 2021-06-18T12:24:11.247

0

It seems you just need to iterate over all subfolders in Outlook to get the number of items per folder.

Sub Test()
 Set objOutlook = CreateObject( "Outlook.Application" )
 Set objNamespace = objOutlook.GetNamespace( "MAPI" )
 Set folders = objNamespace.DefaultStore.GetRootFolder().Folders

 EnumFolders folders
End Sub

Dim counter as Long = 0
' recursively invoked function
Sub EnumFolders(folders)
    For Each folder In folders

        Debug.Print folder.FolderPath

        Debug.Print folder.Count
        
        counter = counter + folder.Items.Count

        EnumFolders folder.Folders
    Next
End Sub

edited Jun 18 '21 at 12:24

answered Jun 17 '21 at 14:01

Eugene Astafiev

47,483
3
24
45

This is correct, but how to collect all emails from all folders in one reference set? Because then, I just call the email that I am interested based on his number reference `InboxItems.Item(nr_index_email).Display` – white_flag Jun 18 '21 at 05:14
In the `EnumFolders` method you can use the `folder` instance to get all the data. – Eugene Astafiev Jun 18 '21 at 06:25
It is possible to sum all Items from a folder: `Set ItemEmail = ItemEmail + folder.Items` – white_flag Jun 18 '21 at 11:24
Yes, you just need to declare a counter at the global scope and add folder's items count each time in the method. – Eugene Astafiev Jun 18 '21 at 12:22
Ok, the items are being counted. Now, how to assign all in one big set of Items? For example: if you loop throe email and set it with `set ItemEmails = folder.Items` , this will assign only emails from the last loop (last folder). How to keep the previews sets? – white_flag Jun 18 '21 at 12:53
Have you tried to run the code under the debugger? – Eugene Astafiev Jun 18 '21 at 13:07
Yes, I have the code tested. And like I said if I put condition for example like this:`If Folder.Name = "Inbox" Then Set ItemEmail = Folder.Items` it is working well (to open the selected email). But can not open emails from Inbox sub-folders because they are not been set it. – white_flag Jun 18 '21 at 13:28

Sum all email.Items from Inbox + subfolders

2 Answers2