在同一个Outlook对话下使用VBA发送电子邮件

我正在使用基本的VBA代码每天发送一份电子邮件和我的电子表格副本。 邮件主题总是一样的。

我希望这些电子邮件在Outlook中显示为相同的对话，以便在使用“对话”视图时将它们嵌套/线程化。 但是，这些电子邮件总是作为一个新的对话来形成。

如何在OutMailvariables中设置一个类似于.subject等的属性来创build我自己的始终相同的ConversationID / ConversationIndex，以便电子邮件显示为嵌套？

VBA代码：

Dim Source As Range 'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm Dim Dest As Workbook Dim wb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim FileExtStr As String Dim FileFormatNum As Long Dim OutApp As Object Dim OutMail As Object Set Source = Nothing On Error Resume Next Set Source = Range("A1:AQ45").SpecialCells(xlCellTypeVisible) On Error GoTo 0 If Source Is Nothing Then MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly Exit Sub End If With Application .ScreenUpdating = False .EnableEvents = False End With Set wb = ActiveWorkbook Set Dest = Workbooks.Add(xlWBATWorksheet) Source.Copy With Dest.Sheets(1) .Cells(1).PasteSpecial Paste:=8 .Cells(1).PasteSpecial Paste:=xlPasteValues .Cells(1).PasteSpecial Paste:=xlPasteFormats .Cells(1).Select Application.CutCopyMode = False End With TempFilePath = "C:\temp\" TempFileName = "MyReport " & Format(Now, "yyyy-mm-dd hh-mm-ss") FileExtStr = ".xlsx": FileFormatNum = 51 Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With Dest .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum On Error Resume Next End With With Dest With OutMail .to = "[e-mail]" .CC = "" .BCC = "" .Subject = "Subject Report 1" .HTMLBody = RangetoHTML(Range("A1:AQ45")) .Attachments.Add Dest.FullName .Send End With End With Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With With Dest On Error GoTo 0 .Close savechanges:=False End With 

Answer 1

这是您可以使用我在上面的注释中build议的方法移植到Excel的Outlook代码。

 Sub test() Dim m As MailItem Dim newMail As MailItem Dim NS As NameSpace Dim convo As Conversation Dim cItem Dim entry As String 'known conversationID property Set NS = Application.GetNamespace("MAPI") 'Use the EntryID of a known item '## MODIFY THIS BASED ON YOUR ENTRYID PROPERTY!! ## entry = "0000000019EF3F5F49714748915AA379833C20460700D6CCDE850A3B9D41A5B930CCE1E12030000337DBD42F00003C7DFC9FAAF8254DACC71DEEEC1DF0A30003ADA9AF2D0000" 'Get a handle on this item: Set m = NS.GetItemFromID(entry) 'Get a handle on the existing conversation Set convo = m.GetConversation 'Get a handle on the conversation's root item: Set cItem = convo.GetRootItems(1) 'Create your new email as a reply thereto: Set newMail = cItem.Reply 'Modify the new mail item as needed: With newMail .To = "" .CC = "" .BCC = "" .Subject = "Subject Report 1" .HTMLBody = RangeToHTML(Range("A1:AQ45")) .Attachments.Add Dest.FullName .Display '.Send End With End Sub