CODEWITHSUNDEEP
excelvbaemailoutlook
JP0710
JP0710

Reputation: 41

Reply to selected Outlook emails using Excel VBA

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

Upvotes: 1

Views: 196

Answers (1)

Eugene Astafiev
Eugene Astafiev

Reputation: 49397

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

Upvotes: 1

Related Questions