Reply only to the latest email in Outlook from Excel VBA

[szalaco]

Dear All,

I have a short and simple macro that replies to a specific email found in my Outlook sent folder based on the subject.
But the issue is that this code opens all mails with that subject. But I would need only the latest reply email to be remained opened (with the entire mail chin). Is there a simple way to do that? Can you help me please?
I'd like to use this code for automatic reminder sending from Excel.

Sub ReplyMail_No_Movements()


Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMail As Variant


Dim i As Integer


Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderSentMail)
i = 1




For Each olMail In Fldr.Items


If InStr(olMail.Subject, ActiveCell.Value) <> 0 Then
With olMail.ReplyAll
            .Display


            '.Save
            '.Close 1
            '.Send
            
End With
i = i + 1
End If


Next olMail


Set olMail = Nothing
Set olApp = Nothing


End Sub

Thank you for your help in advance,
Laszlo

 

[pkearney10]

Hey all,

Wanted to bump this thread as I essentially am looking to do the same thing.

Thanks!

 

[ZVI]

Hi and welcome to MrExcel board!
Select cell with a sought subject text and run this code

Sub ReplyMail_No_Movements()
'ZVI:2018-11-29 https://www.mrexcel.com/forum/general-excel-discussion-other-questions/1048383-reply-only-latest-email-outlook-excel-vba.html
 
  ' Outlook's constant
  Const olFolderSentMail = 5
 
  ' Variables
  Dim OutlookApp As Object
  Dim IsOutlookCreated As Boolean
  Dim sFilter As String, sSubject As String
 
  ' Get/create outlook object
  On Error Resume Next
  Set OutlookApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlookApp = CreateObject("Outlook.Application")
    IsOutlookCreated = True
  End If
  On Error GoTo 0
 
  ' Restrict items
  sSubject = ActiveCell.Value
  sFilter = "[Subject] = '" & sSubject & "'"
 
  ' Main
  With OutlookApp.Session.GetDefaultFolder(olFolderSentMail).Items.Restrict(sFilter)
    If .Count > 0 Then
      .Sort "ReceivedTime", True
      With .Item(1).ReplyAll
        .Display
        '.Send
      End With
    Else
      MsgBox "No emails found with Subject:" & vbLf & "'" & sSubject & "'"
    End If
  End With
 
  ' Quit Outlook instance if it was created by this code
  If IsOutlookCreated Then
    OutlookApp.Quit
    Set OutlookApp = Nothing
  End If
 
End Sub

Regards