VBA to Reply All To Latest Email Thread

**mehdinathani** · 12-22-2020, 11:15 PM

Thanks for below Code, but i want to search in sub folders.

Originally Posted by Excel Fox

As long as it working

I was modifying my code. For my interest, could you test this and let me know

Code:

Option Explicit

Sub ReplyMail_No_Movements()

    Dim olApp As Outlook.Application
    Dim olNs As NameSpace
    Dim Fldr As MAPIFolder
    Dim objMail As Object
    Dim objReplyToThisMail As MailItem
    Dim lngCount As Long
    Dim objConversation As Conversation
    Dim objTable As Table
    Dim objVar As Variant
    Dim strBody As String
    
    Set olApp = Session.Application
    Set olNs = olApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
    
    
    lngCount = 1
    
    For Each objMail In Fldr.Items
        If TypeName(objMail) = "MailItem" Then
            If InStr(objMail.Subject, "REQUEST FOR OVERTIME") <> 0 Then 'REQUEST FOR OVERTIME
                Set objConversation = objMail.GetConversation
                Set objTable = objConversation.GetTable
                objVar = objTable.GetArray(objTable.GetRowCount)
                Set objReplyToThisMail = olApp.Session.GetItemFromID(objVar(UBound(objVar), 0))
                With objReplyToThisMail.ReplyAll
                    strBody = "Hello " & "<br>" & _
                                "<p>Following up with the below. May you please advise?" & _
                                "<p>Thank you," & vbCrLf & vbCrLf & "<br>" & _
                                "<p>" & Session.CurrentUser.Name
                    .HTMLBody = strBody & .HTMLBody
                    .Display
                End With
                Exit For
            End If
        End If
    Next objMail
    
    Set olApp = Nothing
    Set olNs = Nothing
    Set Fldr = Nothing
    Set objMail = Nothing
    Set objReplyToThisMail = Nothing
    lngCount = Empty
    Set objConversation = Nothing
    Set objTable = Nothing
    If IsArray(objVar) Then Erase objVar
    
End Sub