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

时间:2018-10-10 02:24:55

标签: excel vba excel-vba outlook outlook-vba

我有一个向用户发送两个电子邮件提醒的代码。下面所附的代码运行完美。我的问题是,我希望第二个提醒嵌套在第一个提醒中。

'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

第一个提醒嵌套在父级电子邮件的顶部,但对于第二个提醒,不是嵌套在第一个提醒和父级电子邮件的顶部,而是作为单独的邮件嵌套在父级电子邮件的顶部。我该如何解决呢?

编辑 示例:

1。父电子邮件条目ID AABJ23

2.first提醒将entryID设置为AABJ23来回复父级电子邮件 然后在发送电子邮件ABBJ54

后,我将获得一个用于第一个提醒的新条目ID

3.second提醒将条目ID设置为ABBJ54来回复第一条提醒电子邮件

1 个答案:

答案 0 :(得分:0)

您正在使用两个不同的entryID来检索convo.GetRootItems(1),它是原始项。

entryID已经标识了您要回复的邮件。

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