VBA to Reply All To Latest Email Thread

**pkearney10** · 11-29-2018, 12:30 AM

Hello,

I'm trying to build a macro that searches my inbox for a subject line (in this example "REQUEST FOR OVERTIME"), opens the most recent email, and reply all. My macro is a little more nuanced, but borrowed from the example I found online below.

The issue is that it's opening ALL emails with the subject line "REQUEST FOR OVERTIME," not just the most recent. What should I add to this in order to just open the latest message?

Thanks!

Code:

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, "REQUEST FOR OVERTIME") <> 0 Then
        
            Set replyall = olMail.replyall
            With 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
                emailReady = True
            .Display

i = i + 1
End If

Next olMail

Set olMail = Nothing
Set olApp = Nothing

End Sub

**Excel Fox** · 11-30-2018, 05:35 AM

Hi,

You could loop through the sent items that have the specific subject and look for the latest date time. Once you figure that out at the end of the loop, you reply to that particular one.

Can modify the code if you haven't figured it out already. If you have, please post it here.

**pkearney10** · 11-30-2018, 08:56 PM

Thank you! Sorry, I'm sort of new to VBA so I haven't figured that out yet. Any help is GREATLY appreciated!

Also, I don't necessarily need to only look in sent items since I CC myself on my emails, so I only need to look through my inbox for the newest email.

Thanks!

-Patrick

**Excel Fox** · 12-01-2018, 09:37 AM

Patrick,

Yes, this is one way to do it. I haven't tested it extensively, but seems to work

Code:

Sub ReplyMail_No_Movements()

    Dim olApp As Outlook.Application
    Dim olNs As NameSpace
    Dim Fldr As MAPIFolder
    Dim olMail As MailItem
    Dim objReplyToThisMail As MailItem
    Dim lngCount As Long
    Dim objConversation As Conversation
    Dim objTable As Table
    Dim objVar As Variant
    
    Set olApp = Session.Application
    Set olNs = olApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
    
    
    lngCount = 1
    
    For Each olMail In Fldr.Items
        If InStr(olMail.Subject, "REQUEST FOR OVERTIME") <> 0 Then 'Text To Check
            Set objConversation = olMail.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
                emailReady = True
                .Display
            End With
        Exit For
        End If
    Next olMail
    
    Set olApp = Nothing
    Set olNs = Nothing
    Set Fldr = Nothing
    Set olMail = Nothing
    Set objReplyToThisMail = Nothing
    lngCount = Empty
    Set objConversation = Nothing
    Set objTable = Nothing
    If IsArray(objVar) Then Erase objVar
    
End Sub

**pkearney10** · 12-04-2018, 02:30 AM

Thanks so much!

Problem though - when I copy/paste this code into VBA, I get the "run-time error '13': Type mismatch error" and the "Next olMail" gets highlighted. Any idea why?

When I ran into this problem last time, I changed Dim olMail As MailItem to Dim olMail As Variant and it seemed to work. This time if I do that, I get a different error "Run-time error '2147352567 (80020009)': Could Not Send The Message"

**Excel Fox** · 12-04-2018, 07:53 PM

Yeah it is probably because you have item types other than mailitems in your inbox. I think I will need to check for the item type and then proceed with the loop. Give me some time, and I will send a modified version

**pkearney10** · 12-04-2018, 08:11 PM

I got it! Had to Frankenstein some different codes together, but I got it to work. Check it out below (I used the full code which also pulls from a master file in excel to populate the data).

Thanks for the help!

Code:

Sub Follow_Up()

Dim c As Range, f As Range, source As Worksheet, master As Worksheet, s As String, StrBody As String

Dim Fldr As Outlook.Folder
Dim olMail As Variant
Dim olReply As Outlook.MailItem
Dim olItems As Outlook.Items
Dim i As Integer
Dim IsExecuted As Boolean

Set source = Worksheets("Request List")
  Set master = Worksheets("Master List")
  Set olApp = New Outlook.Application
  
  For Each c In source.Range("A2", source.Cells(source.Rows.Count, "A").End(xlUp))
    With c
      If IsEmpty(.Offset(, 3).Value) = True Then GoTo NextC
      If .Offset(, 4).Value <> True Then GoTo NextC
      If .Offset(, 6).Value <> "NO" Then GoTo NextC
      
            Set olApp = New Outlook.Application
      Set olNs = olApp.GetNamespace("MAPI")
      
    Set Fldr = Session.GetDefaultFolder(olFolderInbox)
    IsExecuted = False
    Set olItems = Fldr.Items
    olItems.Sort "[Received]", True
    
    For i = 1 To olItems.Count
        Set olMail = olItems(i)
        If InStr(olMail.Subject, "Document Request: " & c.Offset(, 1).Value) > 0 Then
            If Not olMail.Categories = "Executed" Then
                Set olReply = olMail.replyall
                With olReply
        StrBody = "<BODY style=font-size:11pt;font-family:Calibri>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
                emailReady = True
            .Display
            c.Offset(, 6).Value = "YES"  'Source sheet sent, YES.
            c.Offset(, 7).Value = Date   'Source sheet, Date sent.
            c.Offset(, 8).Value = Session.CurrentUser.Name
                End With
                Exit For
                olMail.Categories = "Executed"
               IsExecuted = True
            End If
        End If
    Next i
    End With
    
NextC:
  Next c
  
  On Error Resume Next
  Set olMail = Nothing
  Set olApp = Nothing
End Sub

**Excel Fox** · 12-04-2018, 09:19 PM

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