Reply to selected Outlook emails using Excel VBA - excel

Question

Using Excel VBA, I want to reply to emails which I selected/highlighted inside the Outlook application.
There are different email messages and subject lines based on the order which I selected the email messages.
There are replies to the wrong email. It should reply to those which I highlighted in Outlook.
For example when I selected three emails there are instances that two replied correctly but the other one replied to an email which I did not highlight.
Sub SendEmail()
Dim OutlookApp As Object
Dim OutlookMail As Object
i = 1
Do While Not IsEmpty(Cells(i + 1, 4))
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.ActiveExplorer.Selection.Item(i)
Dim OutlookConversation As Object
Set OutlookConversation = OutlookMail.GetConversation
Dim OutlookTable As Object
Set OutlookTable = OutlookConversation.GetTable
Dim OutlookAr As Variant
OutlookAr = OutlookTable.GetArray(OutlookTable.GetRowCount)
Dim OutlookReplyToThisMail As Object
Set OutlookReplyToThisMail = OutlookMail.Session.GetItemFromID(OutlookAr(UBound(OutlookAr), 0))
With OutlookReplyToThisMail.ReplyAll
.Subject = Sheet1.Cells(1 + i, 15) & "_" & .Subject
.HTMLBody = "<p style='font-family:calibri;font-size:13'>" & _
Sheet1.Cells(34, 2 + i) & "<br>" & "<br>" & _
Sheet1.Cells(35, 2 + i) & "<br>" & "<br>" & _
Sheet1.Cells(36, 2 + i) & Signature & .HTMLBody
.Display
End With
i = i + 1
Loop
End Sub

Answer 1

First of all, creating a new Outlook Application instance in the loop is not actually a good idea:
Do While Not IsEmpty(Cells(i + 1, 4))
Set OutlookApp = CreateObject("Outlook.Application")
Instead, consider moving the creation line above before the loop:
Set OutlookApp = CreateObject("Outlook.Application")
Do While Not IsEmpty(Cells(i + 1, 4))
In the code you are iterating over Excel cells and get corresponding selected items in Outlook.
it should only reply those which i highlighted in outlook email.
If you need to iterate over all selected items in Outlook you need to not rely on the Excel's data and have got a separate loop based on the number of selected items. For example:
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Set myOlExp = OutlookApplication.ActiveExplorer
Set myOlSel = myOlExp.Selection
For x = 1 To myOlSel.Count
If myOlSel.Item(x).Class = OlObjectClass.olMail Then
' For mail item, use the SenderName property.
Set oMail = myOlSel.Item(x)
Debug.Print oMail.SenderName
End If
Next