Excel VBA回复Outlook电子邮件中的相同对话

时间:2018-09-04 06:49:36

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

*编辑2 我发现了为什么它不会自动发送,我应该使用.send而不是.display。但是我仍然看不到新消息中的父母消息,例如Outlook消息的嵌套视图。

*编辑 因为我有数百个用户,所以我需要通过使用带有excel vba的按钮自动向他们发送电子邮件。并且每个电子邮件提醒都必须与第一封电子邮件位于同一线程中。因此,用户可以看到第一封电子邮件的内容和详细信息。我需要它自动发送,而不是打开新的Outlook窗口。

我有一个程序,可以使用Outlook通过excel vba向用户发送电子邮件。我不想将电子邮件创建为新电子邮件,而是要在与先前电子邮件相同的线程中发送电子邮件。因此,我一直在这里Sending email with VBA under the same Outlook conversation处遵循此代码。

'send reminder

'create session
Dim OutApp As Object
Dim newMail As Object
Dim i, accountSession As Long

'create reply
Dim convo As Conversation
Dim convoItem
Dim entry As String
Dim strgbody, Emailto, ccto, sendfrom As String

Set OutApp = CreateObject("Outlook.Application")
SetEmail = "xyz@outlook.com"

For i = 1 To OutApp.Session.Accounts.Count
        If OutApp.Session.Accounts.Item(i) = SetEmail Then
            accountSession = i
        End If
    Next

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

    Set OutApp = CreateObject("Outlook.Application")
    Set OutNS = OutApp.GetNamespace("MAPI")
    entry = ws.Cells(J, "D").Value
    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, "C").Value
    'ccto = ws.Cells().Value

    On Error Resume Next
    With newMail
        .SendUsingAccount = OutApp.Session.Accounts.Item(accountSession)
        .To = Emailto
        '.CC = ccto
        .BCC = ""
        .Subject = "Subject"
        .BodyFormat = olFormatHTML
        .HTMLBody = "<HTML><BODY>insert body here</BODY></HTML>"
        .Display 'or use .Send
    End With
    On Error GoTo 0
    Set OutApp = Nothing
    Set newMail = Nothing
Next J

但是,代码不会在同一线程中发送它们,而是会打开一个新的电子邮件展望窗口。它不是自动发送的。

我希望用户能够同时看到第一封电子邮件和新邮件。我该如何实现。谢谢

0 个答案:

没有答案