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

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

我希望这些电子邮件在Outlook中显示为同一对话，以便在使用对话视图时嵌套/线程化。然而，这些电子邮件总是作为新的对话出现

我如何在下面的OutMail变量中设置一个类似于.subject等的属性来创建我自己的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 = "xyz@zyx.com"
        .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

---

这是Outlook代码，您可以使用我在上面评论中建议的方法将其移植到Excel

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

---

ConversationID

和

ConversationIndex

都是只读属性。我建议您尝试处理您的电子邮件中的现有对话，作为对该线程中一条消息的回复，这将保留对话视图。密切相关：请参阅“感谢您的帮助”中的示例David！我是一个新手，我是否需要在我的Excel VBA中添加一些参考库才能使其正常工作？我添加了Microsoft Outlook 15邮件库。调试器现在在下面停止，我不知道如何运行它。Set NS=Application.GetNamespace（“MAPI”）错误代码：运行时错误438，对象不支持此属性或方法。谢谢：）在我的代码中，

应用程序将引用Outlook。当您将端口转移到代码时，Outlook的实例为
OutApp
，因此
OutApp.GetNameSpace（“MAPI”）
应该起作用。如果您遇到问题，请修改您的问题，以显示您试图实现的代码，我将帮助您进行调整：）谢谢David。接下来，调试器在Set m=NS.GetItemFromID（entry）处停止，我发现需要根据自己的entryID属性修改entry变量。我在哪里可以找到我的entryID财产？再次感谢你的帮助！使用已知电子邮件项目的entryId属性。您可以使用Google或MS文档来查找如何做到这一点的示例：）上的示例建议您也可以直接修改
新邮件
.ConversationIndex
（通过
创建ConversationIndex
获得）和
.ConversationTopic
。