Sending email with VBA under the same Outlook conversation - vba

Question

I'm using the basic VBA code to send an email with a copy of my spreadsheet on a daily basis. The email subject is always the same.
I want these emails to appear in Outlook as the same conversation, so that they are nested/threaded when using Conversation view. However, these emails always come up as a new conversation.
How can I set a property in the OutMail variable below similar to .subject etc to create my own ConversationID / ConversationIndex that is always identical so that emails appear nested?
VBA code:
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

Answer 1

This is the Outlook code that you can port over to Excel, using the method I suggest in the comments above.
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