VBA to Reply All To Latest Email Thread

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

---

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.eileenslounge.com/viewtopic.php?p=312533#p312533
https://www.eileenslounge.com/viewtopic.php?f=44&t=40373&p=312499#p312499
https://www.eileenslounge.com/viewtopic.php?p=311844#p311844
https://archive.org/download/wlsetup-all_201802/wlsetup-all.exe
https://www.eileenslounge.com/viewtopic.php?p=311826#p311826
https://www.eileenslounge.com/viewtopic.php?f=37&t=40261&p=311783#p311783
https://www.eileenslounge.com/viewtopic.php?p=310916#p310916
https://www.eileenslounge.com/viewtopic.php?p=310720#p310720
https://www.eileenslounge.com/viewtopic.php?f=56&t=40034&p=310171#p310171
https://www.eileenslounge.com/viewtopic.php?p=310110#p310110
https://www.eileenslounge.com/viewtopic.php?p=310024#p310024
https://www.eileenslounge.com/viewtopic.php?p=309121#p309121
https://www.eileenslounge.com/viewtopic.php?p=309101#p309101
https://www.eileenslounge.com/viewtopic.php?p=308945#p308945
https://www.eileenslounge.com/viewtopic.php?f=30&t=39858&p=308880#p308880
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

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.

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

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

---

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"

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

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

---

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

---

Thanks! This one works too it seems (and is definitely cleaner than mine %D ).

Thanks for confirming. Cheers

Hi All,

So I have one last thing I need to throw into this macro that I'm having trouble with. I now keep all my "REQUEST FOR OVERTIME" emails in a separate inbox in my outlook (overtimenotifications@mycompany.com). How do I update this macro to only search for the latest thread in this specific mailbox?

Thanks!

-Patrick

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNsaS3Lp1
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgR1EPUkhw
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNe_XC-jK
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNPOdiDuv
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgN7AC7wAc
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm 9wlhQrYJP3M
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg
https://www.youtube.com/watch?v=DVFFApHzYVk&lc=Ugyi578yhj9zShmhuPl4AaABAg
https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgxvxlnuTRWiV6MUZB14AaABAg
https://www.youtube.com/watch?v=_8i1fVEi5WY&lc=Ugz0ptwE5J-2CpX4Lzh4AaABAg
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxoHAw8RwR7VmyVBUt4AaABAg. 9C-br0lEl8V9xI0_6pCaR9
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=Ugz5DDCMqmHLeEjUU8t4AaABAg. 9bl7m03Onql9xI-ar3Z0ME
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxYnpd9leriPmc8rPd4AaABAg. 9gdrYDocLIm9xI-2ZpVF-q
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgyjoPLjNeIAOMVH_u94AaABAg. 9id_Q3FO8Lp9xHyeYSuv1I
https://www.reddit.com/r/windowsxp/comments/pexq9q/comment/k81ybvj/?utm_source=reddit&utm_medium=web2x&context=3
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm 9wlhQrYJP3M
ttps://www.youtube.com/watch?v=LP9fz2DCMBE
https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg
https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg. 9wdo_rWgxSH9wdpcYqrvp8
ttps://www.youtube.com/watch?v=bFxnXH4-L1A
https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxuODisjo6cvom7O-B4AaABAg.9w_AeS3JiK09wdi2XviwLG
https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxBU39bTptFznDC1PJ4AaABAg
ttps://www.youtube.com/watch?v=GqzeFYWjTxI
https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgwJnJDJ5JT8hFvibt14AaABAg
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

Thanks for below Code, but i want to search in sub folders.

Quote:

---

Originally Posted by Excel Fox

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

---

---

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=314837#p314837
https://www.eileenslounge.com/viewtopic.php?f=21&t=40701&p=314836#p314836
https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314621#p314621
https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314619#p314619
https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314600#p314600
https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314599#p314599
https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314274#p314274
https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314229#p314229
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA