Question

我可以成功使用下面的代码将电子邮件添加到约会，然后再将其保存到我的日历中。但是，当我尝试在进入约会之前填充电子邮件时，一旦将约会保存到Outlook中，它就是空白。

是否有办法将电子邮件保存在约会中，并在With olMail中提供给我的所有相关信息？如果是这样，我该如何实现？

Private Sub calendarUpdate()

'puts an appointment and agenda into my outlook calendar
Dim olApp As Outlook.Application
Dim olApt As AppointmentItem
Dim olMail As MailItem




Set olApp = New Outlook.Application
Set olApt = olApp.CreateItem(olAppointmentItem)
Set olMail = olApp.CreateItem(olMailItem)



emailText = "<H3>Hi Engineer,<br></H3>" & _
            "Can you please fill in the agenda template below (marked red)  and send it back to me ASAP, I will reformat the email where necessary before sending it to the broker/client<br><br>." & _
            "Cheers"

With olMail
    .To = ActiveCell.Offset(0, 21)
    .Subject = ActiveCell.Offset(0, 2) & " " & ActiveCell.Offset(0, 3) & " Agenda Letter Review."
    .HTMLBody = emailText
End With


With olApt
    .AllDayEvent = True
    .Start = Label3.Caption
    .End = Label3.Caption
    .Subject = ActiveCell.Offset(0, 18)
    .Location = ActiveCell.Offset(0, 4) & ", " & ActiveCell.Offset(0, 5) & ", " & ActiveCell.Offset(0, 6) & ", " & ActiveCell.Offset(0, 7) & " " & ActiveCell.Offset(0, 8)
    .Attachment.Add olMail
    .Categories = "EA to Schedule"
    .ReminderSet = True
    .Save
End With


End Sub

Answer 1

我添加了Dim myCopiedMessage As Outlook.MailItem，然后将该项设置为以下

Set myCopiedMessage = olMail.Copy

然后将其添加为附件。我不知道为什么会这样，而我的其他代码却没有，但这不是重点。

Private Sub calendarUpdate()

'puts a possible appointment into my outlook calendar
Dim olApp As Outlook.Application
Dim olApt As Outlook.AppointmentItem
Dim olMail As Outlook.MailItem
Dim myCopiedMessage As Outlook.MailItem



Set olApp = New Outlook.Application
Set olApt = olApp.CreateItem(olAppointmentItem)
Set olMail = olApp.CreateItem(olMailItem)



emailText = "<H3>Hi Engineer,<br></H3>" & _
                "Can you please fill in the agenda template below (marked red) and send it back to me ASAP, I will reformat the email where necessary before sending it to the broker/client<br><br>." & _
                "Cheers"

With olMail
    .To = ActiveCell.Offset(0, 21)
    .Subject = ActiveCell.Offset(0, 2) & " " & ActiveCell.Offset(0, 3) & " Agenda Letter Review."
    .HTMLBody = emailText
End With

Set myCopiedMessage = olMail.Copy

With olApt
    .AllDayEvent = True
    .Start = Label3.Caption
    .End = Label3.Caption
    .Subject = ActiveCell.Offset(0, 18)
    .Location = ActiveCell.Offset(0, 4) & ", " & ActiveCell.Offset(0, 5) & ", " & ActiveCell.Offset(0, 6) & ", " & ActiveCell.Offset(0, 7) & " " & ActiveCell.Offset(0, 8)
    .attachMents.Add myCopiedMessage, 1
    .Categories = "EA to Schedule"
    .ReminderSet = True
    .Save
End With


End Sub

Answer 2

首先保存邮件：

olMail.Save
.Attachment.Add olMail
olMail.Delete

将电子邮件附加到约会

2 个答案: