Excel创buildoutlook会议请求，无法发送

我正在创build一个Outlook会议请求的代码，我希望它发送到被邀请者列表。 我可以创build会议请求，但我无法发送。 我可以在日历中看到会议请求。 我怎样才能发送？

这是我的代码： 

Sub AddAppointments() ' Create the Outlook session Set myOutlook = CreateObject("Outlook.Application") ' Start at row 2 r = 2 Do Until Trim(Cells(r, 1).Value) = "" ' Create the AppointmentItem Set myApt = myOutlook.CreateItem(1) ' Set the appointment properties myApt.Subject = Cells(r, 1).Value myApt.Location = Cells(r, 2).Value myApt.Start = Cells(r, 3).Value myApt.Duration = Cells(r, 4).Value myApt.Recipients.Add Cells(r, 8).Value myApt.MeetingStatus = olMeeting myApt.ReminderMinutesBeforeStart = 88 myApt.Recipients.ResolveAll myApt.AllDayEvent = AllDay ' If Busy Status is not specified, default to 2 (Busy) If Trim(Cells(r, 5).Value) = "" Then myApt.BusyStatus = 2 Else myApt.BusyStatus = Cells(r, 5).Value End If If Cells(r, 6).Value > 0 Then myApt.ReminderSet = True myApt.ReminderMinutesBeforeStart = Cells(r, 6).Value Else myApt.ReminderSet = False End If myApt.Body = Cells(r, 7).Value myApt.Save r = r + 1 myApt.Send Loop End Sub

如果没有示例行值，则很难debugging此代码。 所以我们只是说你的话是有效的。 但是我确实修复了一些代码。

  • 你的代码中有两次ReminderMinutesBeforeStart 。 我删除了第一个，因为它看起来像依赖于行数据。
  • 您可以调用ResolveAll方法，但不要检查收件人是否已解决。 如果他们是电子邮件地址，我不会打扰。
  • 有早期和晚期参考的混合。 例如，您使用1而不是olAppointmentItem，但后来使用olMeeting而不是1。
  • AllDayEvent属性需要一个布尔值，但是因为您还没有声明任何variables，所以我们无法告诉AllDay的含义。 我将其转换为从列I中读取。另请注意，如果将AllDayEvent设置为True，则不需要设置持续时间。

假设有效的input值，这个代码为我工作： 

 Option Explicit Sub AddAppointments() Dim myoutlook As Object ' Outlook.Application Dim r As Long Dim myapt As Object ' Outlook.AppointmentItem ' late bound constants Const olAppointmentItem = 1 Const olBusy = 2 Const olMeeting = 1 ' Create the Outlook session Set myoutlook = CreateObject("Outlook.Application") ' Start at row 2 r = 2 Do Until Trim$(Cells(r, 1).value) = "" ' Create the AppointmentItem Set myapt = myoutlook.CreateItem(olAppointmentItem) ' Set the appointment properties With myapt .Subject = Cells(r, 1).value .Location = Cells(r, 2).value .Start = Cells(r, 3).value .Duration = Cells(r, 4).value .Recipients.Add Cells(r, 8).value .MeetingStatus = olMeeting ' not necessary if recipients are email addresses ' myapt.Recipients.ResolveAll .AllDayEvent = Cells(r, 9).value ' If Busy Status is not specified, default to 2 (Busy) If Len(Trim$(Cells(r, 5).value)) = 0 Then .BusyStatus = olBusy Else .BusyStatus = Cells(r, 5).value End If If Cells(r, 6).value > 0 Then .ReminderSet = True .ReminderMinutesBeforeStart = Cells(r, 6).value Else .ReminderSet = False End If .Body = Cells(r, 7).value .Save r = r + 1 .Send End With Loop End Sub

单元格中的样本input值（包括标题行）：

  • A2：我的会议
  • B2：我的桌子
  • C2：11/25/2011 13:30:00 PM
  • D2：30
  • E2：2
  • F2：30
  • G2：开个会吧！
  • H2：电子邮件地址 –
  • I2：错误

这个对我有用！

请记住有多行像 

 .Recipients.Add Cells(r, 8).value

添加更多收件人。 由于在一个单元格中写入多个地址， 导致预约时发生错误！

或使用 

 .Recipients.ResolveAll
Interesting Posts