在同一Outlook對話下發送帶有VBA的電子郵件

Question

我使用基本的VBA代碼每天發送一份包含電子表格副本的電子郵件。電子郵件主題總是相同的。

我希望這些電子郵件作爲相同的對話出現在Outlook中，以便它們在使用對話視圖時嵌套/線程化。但是，這些電子郵件總是以新的對話形式出現。

如何在類似於.subject等的OutMail變量中設置屬性，以創建自己的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 

Answer 1

這是你可以通過到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