отправлять Outlook по электронной почте во вложенном представлении с помощью Excel VBA - PullRequest
Новая
       21

отправлять Outlook по электронной почте во вложенном представлении с помощью Excel VBA

0 голосов
/ 10 октября 2018

У меня есть код, который отправляет два напоминания по электронной почте пользователю.Приведенный ниже код работал отлично.Моя проблема в том, что я хочу, чтобы второе напоминание было вложенным из первого.

'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. Родительский идентификатор записи электронной почты AABJ23

2.Первое напоминание ответит на родительский адрес электронной почтыустановив entryID на AABJ23, я получу новый идентификатор записи для первого напоминания после того, как я отправил электронное письмо, ABBJ54

3. Второе напоминание ответит на первое электронное письмо с напоминанием, установив идентификатор записи на ABBJ54 * 1014.*

1 Ответ

0 голосов
/ 11 октября 2018

Вы используете два разных идентификатора записи для получения convo.GetRootItems(1), который является исходным элементом.

Идентификаторы ввода уже идентифицируют почту, на которую вы хотите ответить. 

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
...