使用 Excel 数据创建 Outlook 会议请求

Question

我正在编写代码以创建 Outlook 会议请求以发送给受邀者列表。
我在日历中看到会议请求，但无法发送。
我怎样才能让它发送？

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

Answer 1

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

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

假设输入值有效，此代码对我有用：

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

单元格中的示例输入值（包括标题行）：

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

Answer 2

这个对我有用！

请记住有多行，如

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

添加更多收件人。 因为在一个单元格中写入多个地址，以“;”分隔发送约会时导致错误！

或使用

.Recipients.ResolveAll