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

Question

我每天使用基本的 VBA 代码发送一封包含电子表格副本的电子邮件。电子邮件主题始终相同。

我希望这些电子邮件在 Outlook 中显示为同一对话，以便在使用对话 View 时将它们嵌套/串联。但是，这些电子邮件总是作为新对话出现。

如何在下面的 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

Answer 1

这是 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