在同一Outlook对话下使用VBA发送电子邮件 [英] Sending email with VBA under the same Outlook conversation

问题描述

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

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.

我希望这些电子邮件以相同的对话形式出现在Outlook中，以便在使用对话"视图时将它们嵌套/嵌套.但是，这些电子邮件总是以新的对话形式出现.

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.

如何在OutMail变量下方设置类似于.subject等的属性，以创建自己的始终相同的ConversationID/ConversationIndex，以便电子邮件看起来是嵌套的?

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代码:

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 = "[e-mail]"
        .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

推荐答案

这是可以使用我在上面的注释中建议的方法移植到Excel的Outlook代码.

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

这篇关于在同一Outlook对话下使用VBA发送电子邮件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！