CODEWITHSUNDEEP
excelvbaoutlook
RK144
RK144

Reputation: 47

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

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>" & _
              "<A HREF=""file://" & fpath & """>" & fpath & "</A>" & .HTMLBody

            .Display
            Exit For

        End With

    End If
Next

End Sub

Upvotes: 1

Views: 1858

Answers (1)

0m3r
0m3r

Reputation: 12499

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

Upvotes: 1

Related Questions