동일한 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