Sending email with VBA under the same Outlook conversation

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