Reply to All on Latest Sent Email Using Partial Subject Name only

Viewed 74

I have few reports to sent on daily basis sometimes as per requirement twice or thrice in a week with Subject Name Like "Sales Report till 01-Sep-2022" in which only the date changes and initial like "Sales Report till*" remains the same.

Below is the code which works well on "Replying to All" from sent items. The only problem is it's not replying on latest Sent Email.

Means when it replies it automatically picks any email after "Sales Report till" whether that sent mail is from last week or last months.

As most of the times emails changes. So I want few modification in below code to Reply to All it on Latest Sent Email.

Went online to found some code but unfortunately not able to get the desired output.

Any help in this context will be grateful

Sub OL_Email_Reply_To_All_WFN()

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 Path, WFN, SN As String
Dim WFN_Sub, WFN_RN, WFN_MB As String

Path = ThisWorkbook.Sheets("Main_Sheet").Range("B1") & "\"    '''''Path to pick from "Main_Sheet" of ThisWorkbook
 WFN = Path & ThisWorkbook.Sheets("Main_Sheet").Range("B2")   ''''' Working File Name can be diffrent will change on sheet.
  
  
''''WFN_Sub = ThisWorkbook.Sheets("Main_Sheet").Range("B3")
''''WFN_RN = ThisWorkbook.Sheets("Main_Sheet").Range("B4")
''''WFN_MB = ThisWorkbook.Sheets("Main_Sheet").Range("B5")
''''WFN_SN = ThisWorkbook.Sheets("Main_Sheet").Range("B6")


'''''Original Subject Name looks like "Sales Report till 01-Sep-2022" in which date changes every everytime.

WFN_Sub = "Test Email"   '''''Subject to find should be intial only
WFN_RN = "Hi Friend"     '''''Recipient Name
WFN_MB = "Please ignore it's a Test Email"    ''''''''''Mail Body
    SN = "My Name"   '''''''''Senders Name


Set olApp = Session.Application
 Set olNs = olApp.GetNamespace("MAPI")
 Set Fldr = olNs.GetDefaultFolder(olFolderSentMail)

 lngCount = 1


ThisWorkbook.Activate
For Each objMail In Fldr.Items
If TypeName(objMail) = "MailItem" Then
If InStr(objMail.Subject, WFN_Sub) <> 0 Then

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
.Subject = WFN_Sub & " " & Format(Now() - 1, "DD-MMM-YYYY")
.HTMLBody = WFN_RN & "<br> <br>" & WFN_MB & "<br> <br>" & "Kind Regards" & "<br>" & SN
.display
.Attachments.Add WFN

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

 
1 Answers

Before getting the last row in the table (retrieved from the conversation object) you need to sort items based on the recieved date:

 'Sort by ReceivedTime in descending order 
 table.Sort "[ReceivedTime]", True 

Only after that you may rely on the last item in the code.

Related