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属性需要一个布尔值,但你有没有声明的变量,我们没有办法告诉什么阿迪手段.我将其转换为从第I列读取.另请注意,如果将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:假