Looping through all the folders in outlook using vba

Question

Have been wrestling with the following sub-routine.

I use it personally for my computer, the problem is that in my colleagues' computers it doesn't work because he decided to separate his inbox in different folders (this is supposed to loop through all the emails in the default folder).

I modified it a bit using code I've found here but it doesn't seem to work. Can you guys help me find where I went wrong?

Sub LoopReply3(Filepath As String, name As String)

Dim objNS As Outlook.Namespace: Set objNS = Outlook.GetNamespace("MAPI")
Dim olFolder As Outlook.MAPIFolder
Dim item As Object
Dim Newmail As MailItem
Dim mailfolder As Outlook.Items
Dim sFilter As String

sFilter = "@SQL=""http://schemas.microsoft.com/mapi/proptag/0x0037001f"" like '%" & name & "%'"

For Each olFolder In objNS.Folders

    Set mailfolder = olFolder.Items.Restrict(sFilter)
    mailfolder.Sort "ReceivedTime", True


    For Each item In mailfolder
        If TypeOf item Is Outlook.MailItem Then
            Dim oMail As Outlook.MailItem: Set oMail = item
                'The problem is not the code that is supposed to go here
            End If
        End If
    Next
Next

End Sub

https://stackoverflow.com/questions/2272361/can-i-iterate-through-all-outlook-emails-in-a-folder-including-sub-folders — Tim Williams, Aug 07 '23 at 19:10

score 1 · Answer 1 · answered Aug 07 '23 at 19:27

Here's an example of processing subfolders (without the "restrict" part, for clarity..)

Sub LoopReply3()

    Dim objNS As Outlook.NameSpace
    Dim olFolder As Outlook.MAPIFolder, sf As Outlook.MAPIFolder
    Dim folders As New Collection, arr
    
    Set objNS = Outlook.GetNamespace("MAPI")
    
    'collect all the top-level folders
    For Each olFolder In objNS.folders
        'using an array to also track the folder path...
        folders.Add Array(olFolder, olFolder.name)
    Next olFolder
    
    Do While folders.Count > 0      'loop while have folders to process
        arr = folders(1)            'get item#1
        Set olFolder = arr(0)
        folders.Remove 1              'remove from collection
        Debug.Print "Processing:" & arr(1) 'path
        
        'process mails in `olFolder`
        
        For Each sf In olFolder.folders  'loop any subfolders
            folders.Add Array(sf, arr(1) & "\" & sf.name) 'add to collection for processing
        Next sf
    Loop
    
End Sub

If this solved your problem, please flag as "Accepted" by clicking the checkmark next to the answer. This helps anyone coming along later with a similar question to see there's a working solution. — Tim Williams, Aug 08 '23 at 18:42

Looping through all the folders in outlook using vba

1 Answers1