使用 excel vba 在嵌套视图中发送 Outlook 电子邮件

Question

I have a code that send two email reminder to user. The code attached below worked perfectly. My problem is that, I want the second reminder to be nested from the first reminder.

'create session
Dim OutApp As Object
Dim newMail As Object
Dim Emailto, sendfrom As String

'create reply
Dim convo As Conversation
Dim convoItem
Dim entry As String

For J = ws.Cells(5, "C").Value To ws.Cells(6, "C").Value

'get value from combo box
If combovalue = "First Reminder" Then
'MsgBox combovalue

'set a reply
Set OutApp = CreateObject("Outlook.Application")
Set OutNS = OutApp.GetNamespace("MAPI")
entry = ws.Cells(J, "G")
Set mail = OutNS.GetItemFromID(entry) 'get handle on mail item
Set convo = mail.GetConversation 'get handle on existing conversation
Set convoItem = convo.GetRootItems(1) 'get convo root item
Set newMail = convoItem.Reply 'new email as reply to convo
Emailto = ws.Cells(J, "D").Value
sendfrom = "email"

On Error Resume Next
With newMail
.SendUsingAccount = sendfrom
.To = Emailto
.Subject = "Test"
.VotingOptions = "Acknowledge;"
.BodyFormat = olFormatHTML
.HTMLBody = "Body here"
.Send 'or use .Display to open Outlook's new message window before sending
ws.Cells(J, "T").Value = Date
End With

On Error GoTo 0
Set OutApp = Nothing
Set newMail = Nothing
End If

If combovalue = "Second Reminder" Then
'MsgBox ("Correct")
Set OutApp = CreateObject("Outlook.Application")
Set OutNS = OutApp.GetNamespace("MAPI")
entry = ws.Cells(J, "Z")
Set mail = OutNS.GetItemFromID(entry) 'get handle on mail item
Set convo = mail.GetConversation 'get handle on existing conversation
Set convoItem = convo.GetRootItems(1) 'get convo root item
Set newMail = convoItem.Reply 'new email as reply to convo
Emailto = ws.Cells(J, "D").Value
sendfrom = "email"

On Error Resume Next
With newMail
.SendUsingAccount = sendfrom
.To = Emailto
.BCC = ""
.Subject = "Test"
.VotingOptions = "Acknowledge;"
.BodyFormat = olFormatHTML
.HTMLBody = "Body here"
.Send 'or use .Display to open Outlook's new message window before sending
ws.Cells(J, "U").Value = Date
End With

On Error GoTo 0
Set OutApp = Nothing
Set newMail = Nothing
End If
Next J

the first reminder is nested on top of parent email, but for second reminder, instead of nested on top of first reminder and parent email, it was send as a separate mail nested on top of parent email. how can i solve this??

EDIT Example:

1.parent email entry ID AABJ23

2.first reminder will reply to parent email by setting the entryID to AABJ23 then I will get a new entry ID for the first reminder after i sent the email, ABBJ54

3.second reminder will reply to first reminder email by setting the entry ID to ABBJ54

Answer 1

You are using the two different entryIDs to retrieve convo.GetRootItems(1) which is the originating item.

The entryIDs already identify the mail you want to reply to.

If comboValue = "First Reminder" Then

    entry = ws.Cells(j, "G") ' entryID of the parent mail
    Set Mail = OutNS.GetItemFromID(entry) 'get handle on parent mail
    Set newMail = Mail.reply 'new email as reply to parent mail

End If

If comboValue = "Second Reminder" Then

    entry = ws.Cells(j, "Z") ' entryID of first reminder
    Set Mail = OutNS.GetItemFromID(entry) 'get handle on first reminder item
    Set newMail = Mail.reply 'new email as reply to first reminder

End If