VBA to Reply All To Latest Email Thread

[pkearney10]

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!



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

[Excel Fox]

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]

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]

Patrick,

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



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]

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]

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]

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!



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]

As long as it working :)

I was modifying my code. For my interest, could you test this and let me know



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

[pkearney10]

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

[Excel Fox]

Thanks for confirming. Cheers

[pkearney10]

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/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg (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.9BLeCWVhxdG9wgNsaS3Lp1)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgR1EPUkhw (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.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.9BLeCWVhxdG9wgNPOdiDuv)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgN7AC7wAc (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgN7AC7wAc)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M (https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg (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=DVFFApHzYVk&lc=Ugyi578yhj9zShmhuPl4AaABAg)
https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgxvxlnuTRWiV6MUZB14AaABAg (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=_8i1fVEi5WY&lc=Ugz0ptwE5J-2CpX4Lzh4AaABAg)
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxoHAw8RwR7VmyVBUt4AaABAg.9C-br0lEl8V9xI0_6pCaR9 (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=Ugz5DDCMqmHLeEjUU8t4AaABAg.9bl7m03Onql9xI-ar3Z0ME)
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxYnpd9leriPmc8rPd4AaABAg.9gdrYDocLIm9xI-2ZpVF-q (https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxYnpd9leriPmc8rPd4AaABAg.9gdrYDocLIm9xI-2ZpVF-q)
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgyjoPLjNeIAOMVH_u94AaABAg.9id_Q3FO8Lp9xHyeYSuv 1I (https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgyjoPLjNeIAOMVH_u94AaABAg.9id_Q3FO8Lp9xHyeYSuv 1I)
https://www.reddit.com/r/windowsxp/comments/pexq9q/comment/k81ybvj/?utm_source=reddit&utm_medium=web2x&context=3 (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=UgxYgiEZuS9I3xkjJv54AaABAg)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M (https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M)
ttps://www.youtube.com/watch?v=LP9fz2DCMBE (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)
https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg.9wdo_rWgxSH9wdpcYqrv p8 (https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg.9wdo_rWgxSH9wdpcYqrv p8)
ttps://www.youtube.com/watch?v=bFxnXH4-L1A (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=UgxuODisjo6cvom7O-B4AaABAg.9w_AeS3JiK09wdi2XviwLG)
https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxBU39bTptFznDC1PJ4AaABAg (https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxBU39bTptFznDC1PJ4AaABAg)
ttps://www.youtube.com/watch?v=GqzeFYWjTxI (ttps://www.youtube.com/watch?v=GqzeFYWjTxI)
https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgwJnJDJ5JT8hFvibt14AaABAg (https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgwJnJDJ5JT8hFvibt14AaABAg)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[mehdinathani]

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


As long as it working :)

I was modifying my code. For my interest, could you test this and let me know



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.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=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=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=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=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=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=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=314274#p314274)
https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314229#p314229 (https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314229#p314229)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)