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