How to Search Outlook mails with in the inbox and sub folders - excel

Question

I have created a macro which takes the latest mail and send the reply all.
Now how do I search Inbox and sub folders and pick the latest one.
My code picks the mail only from Inbox.
Option Explicit
Public Sub TESTRUN()
Dim olApp As Outlook.Application
Set olApp = New Outlook.Application
Dim olNs As Outlook.Namespace
Set olNs = olApp.GetNamespace("MAPI")
Dim Inbox As Outlook.MAPIFolder
Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
Dim Subject As String
Subject = ThisWorkbook.Sheets("SendMail").Range("B5").Text
Debug.Print Subject
Dim fpath As String
fpath = ThisWorkbook.Sheets("SendMail").Range("A8").Value
Dim i As Long
Dim Filter As String
Filter = "#SQL=" & Chr(34) & "urn:schemas:httpmail:datereceived" & _
Chr(34) & " >= '01/01/1900' And " & _
Chr(34) & "urn:schemas:httpmail:datereceived" & _
Chr(34) & " < '12/31/2100' And " & _
Chr(34) & "urn:schemas:httpmail:subject" & _
Chr(34) & "Like '%" & Subject & "%'"
Dim Items As Outlook.Items
Set Items = Inbox.Items.Restrict(Filter)
Items.Sort "[ReceivedTime]", False
For i = Items.Count To 1 Step -1
DoEvents
If TypeOf Items(i) Is MailItem Then
Dim Item As Object
Set Item = Items(i)
Debug.Print Item.Subject ' Print on Immediate Window
Debug.Print Item.ReceivedTime ' Print on Immediate Window
Dim ReplyAll As Outlook.MailItem
Set ReplyAll = Item.ReplyAll
With ReplyAll
.Subject = Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".") - 1)
.HTMLBody = "<font size=""3"" face=""Calibri"">" & _
"Hi Veronica, <br><br>" & _
"The " & Left(ActiveWorkbook.Name, _
InStr(ActiveWorkbook.Name, ".") - 1) & _
"</B> has been prepared and ready for your review.<br>" & _
"</B> <br>" & _
"" & fpath & "" & .HTMLBody
.Display
Exit For
End With
End If
Next
End Sub

Answer 1

You could convert your code recursive function start from Inbox :Example
Option Explicit
Public Sub Example()
Dim olNs As Outlook.NameSpace
Dim Inbox As Outlook.MAPIFolder
Set olNs = Application.GetNamespace("MAPI")
Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
' // Process Current Folder
LoopFolders Inbox
Set Inbox = Nothing
End Sub
Private Function LoopFolders(ByVal ParentFldr As Outlook.MAPIFolder)
Dim Subject As String
Subject = ThisWorkbook.Sheets("SendMail").Range("B5").Text
Dim FPath As String
FPath = ThisWorkbook.Sheets("SendMail").Range("A8").Value
Dim Filter As String
Filter = "#SQL=" & Chr(34) & "urn:schemas:httpmail:datereceived" & _
Chr(34) & " >= '01/01/1900' And " & _
Chr(34) & "urn:schemas:httpmail:datereceived" & _
Chr(34) & " < '12/31/2100' And " & _
Chr(34) & "urn:schemas:httpmail:subject" & _
Chr(34) & "Like '%" & Subject & "%'"
Dim Items As Outlook.Items
Set Items = ParentFldr.Items.Restrict(Filter)
Items.Sort "[ReceivedTime]", False
Dim i As Long
For i = Items.Count To 1 Step -1
DoEvents
If TypeOf Items(i) Is MailItem Then
Dim Item As Object
Set Item = Items(i)
Debug.Print Item.Subject & " " & Item.ReceivedTime
Dim ReplyAll As Outlook.MailItem
Set ReplyAll = Item.ReplyAll
With ReplyAll
.Subject = ""
.HTMLBody = "" '
.Display
End With
Exit Function
End If
Next
Dim SubFldr As Outlook.MAPIFolder
' // Recurse through SubFldrs
If ParentFldr.Folders.Count > 0 Then
For Each SubFldr In ParentFldr.Folders
LoopFolders SubFldr
Debug.Print SubFldr.Name
Next
End If
End Function