首页 文章

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

提问于
浏览 次
4

我正在使用基本的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
excel vba email excel-vba outlook

1 回答

  • 1

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

    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
    回复于

相关问题