ReplyAll to Most Recent Outlook Mail

[nuckfuts]

Hi All -

I have the below code which generates a "ReplyAll" response based on the cell values in row i - macro is triggered by clicking into Cell "V" & i
It works great but it pulls up any email matching my subject criteria. I would like to just pull the most recent email and reply all to that.

Notes: Column "V" contains "Send" which executes the code once clicked as long as nothing is in the corresponding "W" column. Once sent, "W" gets populated with the date.
The code is contained within Sheet1 of my worksheet (not a separate module)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("V:V")) Is Nothing Then
        If Target.Value = "Send" Then
        i = Target.Row
            If Sheet1.Cells(i, "W").Value = Date Then
            MsgBox "already sent"
                Exit Sub
            End If
        Dim Answer As Integer
        Answer = MsgBox("Resend?", vbOKCancel)
        If Answer = vbCancel Then
            Exit Sub
        End If
        Call SendEmail(i)
        End If
    End If

End Sub

Sub SendEmail(i As Long)
    Dim OutApp As Object
    Dim OUtMail As Object
    Dim Signature As String
    Dim backMsg As String
    Dim objDoc As Object
    Dim objBkm As Object
    Dim olApp As Outlook.Application
    Dim olNs As Namespace
    Dim FlDr As MAPIFolder
    Dim olMail As Variant
    Dim olReply As Outlook.MailItem
    Dim ZZZfldr As Outlook.Folder
    Dim IsOutlookCreated As Boolean
    Dim sSubject As String
    
    Application.ScreenUpdating = False
    
    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    Set FlDr = olNs.GetDefaultFolder(olFolderInbox)
    Set ZZZfldr = FlDr.Folders("ZZZ subfolder")
    sSubject = Cells.Range("AA2")
    
    For Each olMail In ZZZfldr.Items
        If IsOutlookCreated = True Then GoTo StopLoop
            If InStr(olMail.Subject, sSubject) <> 0 Then
                IsOutlookCreated = True
                Set OutApp = CreateObject("Outlook.Application")
                Set OUtMail = OutApp.CreateItem(0)
                'here I just get my HTML signature w/o the additional spaces
                With OUtMail
                    .Display
                End With
                Set objDoc = OUtMail.GetInspector.WordEditor
                Set objBkm = objDoc.Bookmarks("_MailAutoSig")
                
                If Not objBkm Is Nothing Then
                    objBkm.Select
                    objDoc.Windows(1).Selection.Move 6, -1
                    objDoc.Windows(1).Selection.Delete
                End If
                Signature = OUtMail.HTMLBody
                OUtMail.Close 1
                
                Set olReply = olMail.ReplyAll
                    olReply.Display
                    backMsg = olMail.HTMLBody 'to paste previous message chain under new body
                    With olReply
                        .HTMLBody = "Lots of stuff" & Signature & backMsg
                    End With
            On Error GoTo erHandle
            End If
        Next olMail
        
            Sheets1.Cells(i, "W").Value = Date
            Set OUtMail = Nothing
            Set OutApp = Nothing
StopLoop:
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
Exit Sub
End Sub

I realize this is pretty jumbled as I've been piecing it together using a lot of sources. If you have any suggestions for cleaning it up or making it run faster (takes about 5-6 second) I'm all ears! Thanks!

 

[nuckfuts]

Bump - anyone have any suggestions here?

 

[nuckfuts]

One last try here - anyone have any ideas? Also if this is not possible please comment that and let me know!