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，但后来使用的，而不是1
• 的AllDayEvent属性采用布尔值olMeeting，但你有没有声明的变量，我们没有办法告诉什么阿迪手段。我将其转换为从列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：-email地址 -
• I2：FALSE

Answer 2

这对我的作品！

请记住，有一个像

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

多行来添加更多的收件人。 由于在一个单元格中写入了多个地址，其中“;”导致预约发生错误！

或使用

.Recipients.ResolveAll