创建格式化约会后草稿仍然存在答案

【问题标题】：Draft remains after creating a formatted appointment创建格式化约会后草稿仍然存在
【发布时间】：2019-12-18 17:10:40
【问题描述】：

我有 Excel VBA，它从电子表格中获取数据，然后向团队成员和客户发送 Outlook 日历邀请。

它在收件人：字段或主题中保留没有联系人的草稿。这是我的代码的问题，还是 Outlook 的问题？

Dim olApp As Outlook.Application
Dim olEmail As Outlook.MailItem
Dim olCal As Outlook.AppointmentItem
Dim olFolder As Outlook.Folder
Dim RequiredAttendee, OptionalAttendee, ResourceAttendee As Outlook.Recipient
Dim rtf() As Byte

Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder
Dim rngTo As Range
Dim rngCC As Range
Dim rngSUB As Range
Dim rngCALloc As Range
Dim rngCALstart As Range
Dim rngCALend As Range
Dim rngBody As Range
Dim myItem As Object

Dim oApp As Object
Dim oNameSpace As Namespace
Dim oFolder As Object

Sub SVN()
'Creates Outlook Calendar Site Visit Notification for one day onsite.'
    Set olApp = New Outlook.Application
    Set m = olApp.CreateItem(olMailItem)
    Set appt = olApp.CreateItem(olAppointmentItem)
        
    With ActiveSheet
        Set rngTo = .Range("J3")
        Set rngCC = .Range("J4")
        Set rngCALloc = .Range("J5")
        Set rngCALstart = .Range("J7")
        Set rngCALend = .Range("J8")
        Set rngSUB = .Range("J14")
    End With
    
    MsgBox "Verify Attendees:  Customer, Sales, Service."
            
    appt.MeetingStatus = olMeeting
    appt.RequiredAttendees = rngTo.Value
    appt.OptionalAttendees = rngCC.Value
    appt.Subject = rngSUB.Value
    appt.Location = rngCALloc.Value
        
    appt.Start = rngCALstart.Value
    appt.End = rngCALend.Value
    appt.AllDayEvent = True
        
    m.BodyFormat = olFormatHTML
    m.HTMLBody = Range("J16").Value
    m.GetInspector().WordEditor.Range.FormattedText.Copy
    appt.GetInspector().WordEditor.Range.FormattedText.Paste
    appt.Display
    
End Sub

【问题讨论】：

仅供参考 - Dim RequiredAttendee, OptionalAttendee, ResourceAttendee As Outlook.Recipient。只有ResourceAttendee 必须是Outlook.Recipient。其他的是Variant...你需要显式声明所有变量类型，否则默认为Variant。（这可能不是问题，只是想指出这一点。）

标签： excel vba outlook appointment

【解决方案1】：

您实际上是在创建一个邮件项目以格式化电子表格中的文本并将其复制/粘贴到约会中然后永远不会关闭该邮件项目。请参阅注释代码下面。

最简单的解决方案可能是在末尾添加m.Close olDiscard。更“有效”的解决方案是删除需要仅为将文本格式化为约会而创建的邮件的逻辑。

Sub SVN()
'Creates Outlook Calendar Site Visit Notification for one day onsite.'
    Set olApp = New Outlook.Application
    Set m = olApp.CreateItem(olMailItem) '<--------------Make new mail item
    Set appt = olApp.CreateItem(olAppointmentItem)

    With ActiveSheet
        Set rngTo = .Range("J3")
        Set rngCC = .Range("J4")
        Set rngCALloc = .Range("J5")
        Set rngCALstart = .Range("J7")
        Set rngCALend = .Range("J8")
        Set rngSUB = .Range("J14")
    End With

    MsgBox "Verify Attendees:  Customer, Sales, Service."

        appt.MeetingStatus = olMeeting
        appt.RequiredAttendees = rngTo.Value
        appt.OptionalAttendees = rngCC.Value
        appt.Subject = rngSUB.Value
        appt.Location = rngCALloc.Value

        appt.Start = rngCALstart.Value
        appt.End = rngCALend.Value
        appt.AllDayEvent = True

        m.BodyFormat = olFormatHTML '<-----------Adjust new mail item bodyformat to HTML
        m.HTMLBody = Range("J16").Value '<-------Paste data from spreadsheet into mail item
        m.GetInspector().WordEditor.Range.FormattedText.Copy '<-----Copy the formatted text from mail item
        appt.GetInspector().WordEditor.Range.FormattedText.Paste '<----Paste into the appointment.
        m.Close olDiscard '<----This is new. Close the mail item and discard (no save)
        appt.Display


End Sub

【讨论】：