如何在添加參加者後將附件添加到AppointmentItem？

Question

因此，我正在開發一些需要約會的代碼，並從約會創建一些任務，並在發送前檢查是否有附件。

當我沒有其他與會者時，代碼工作正常。但是，一旦添加了與會者，代碼就會卡在打開文件附件對話框中。的Bleh！

我已經把它貼下面的代碼：

Public WithEvents myItem As Outlook.appointmentitem 

Private Sub myItem_Write(Cancel As Boolean) 
    Dim myResult As Integer 
    Dim olApp As Outlook.Application 
    Dim olTsk As TaskItem 
    Dim olAppt As appointmentitem 
    Dim TskSubj As String 
    Dim ApptSubj As String 
    Dim olNS As Outlook.NameSpace 
    Dim myolApp As Outlook.Application 

    Set olApp = New Outlook.Application 
    Set olTsk = olApp.CreateItem(olTaskItem) 

    With olTsk 
     olTsk.DueDate = myItem.Start - 1 
     olTsk.Subject = myItem.Subject 
     olTsk.Subject = replace(olTsk.Subject, "BC Test/Review", "Send BCP Docs") 
     olTsk.Body = "Attending: " & myItem.RequiredAttendees 
     olTsk.ReminderSet = True 
     olTsk.ReminderTime = olTsk.DueDate & " " & Format("10:00 AM") 

     End With 

     olTsk.Save 

    Set olTsk = Nothing 
    Set olApp = Nothing 

    Set olApp = New Outlook.Application 
    Set olTsk = olApp.CreateItem(olTaskItem) 

     With olTsk 
     olTsk.DueDate = myItem.Start + 30 
     olTsk.Subject = myItem.Subject 
     olTsk.Body = "Attending: " & myItem.RequiredAttendees 
     olTsk.ReminderSet = True 
     olTsk.ReminderTime = olTsk.DueDate & " " & Format("10:00 AM") 

       olTsk.Subject = replace(olTsk.Subject, "BC Test/Review", "BCP Updates due") 

     End With 

     olTsk.Save 

    Set olTsk = Nothing 
    Set olApp = Nothing 

    Set olApp = New Outlook.Application 
    Set olTsk = olApp.CreateItem(olTaskItem) 

     With olTsk 
     olTsk.DueDate = myItem.Start + 20 
     olTsk.Subject = myItem.Subject 
     olTsk.Body = "Attending: " & myItem.RequiredAttendees 
     olTsk.ReminderSet = True 
     olTsk.ReminderTime = olTsk.DueDate & " " & Format("10:00 AM") 

       olTsk.Subject = replace(olTsk.Subject, "BC Test/Review", "BIA Team Leader Signature") 

     End With 

     olTsk.Save 

    Set olTsk = Nothing 
    Set olApp = Nothing 

    Set olApp = New Outlook.Application 
    Set olTsk = olApp.CreateItem(olTaskItem) 

     With olTsk 
     olTsk.DueDate = myItem.Start + 30 
     olTsk.Subject = myItem.Subject 
     olTsk.Body = "Attending: " & myItem.RequiredAttendees 
     olTsk.ReminderSet = True 
     olTsk.ReminderTime = olTsk.DueDate & " " & Format("10:00 AM") 

       olTsk.Subject = replace(olTsk.Subject, "BC Test/Review", "BIA Executive Approver Signature") 

     End With 

     olTsk.Save 

    Set olTsk = Nothing 
    Set olApp = Nothing 

    Set olApp = New Outlook.Application 
    Set olTsk = olApp.CreateItem(olTaskItem) 

     With olTsk 
     olTsk.DueDate = myItem.Start + 1 
     olTsk.Subject = myItem.Subject 
     olTsk.Body = "Attending: " & myItem.RequiredAttendees 
     olTsk.ReminderSet = True 
     olTsk.ReminderTime = olTsk.DueDate & " " & Format("10:00 AM") 

       olTsk.Subject = replace(olTsk.Subject, "BC Test/Review", "Send BIA Link") 

     End With 

     olTsk.Save 

    Set olTsk = Nothing 
    Set olApp = Nothing 

     Set olApp = New Outlook.Application 
    Set olTsk = olApp.CreateItem(olTaskItem) 

     With olTsk 
     olTsk.DueDate = myItem.Start + 30 
     olTsk.Subject = myItem.Subject 
     olTsk.Body = "Attending: " & myItem.RequiredAttendees 
     olTsk.ReminderSet = True 
     olTsk.ReminderTime = olTsk.DueDate & " " & Format("10:00 AM") 

       olTsk.Subject = replace(olTsk.Subject, "BC Test/Review", "LDRPS") 

     End With 

     olTsk.Save 

    Set olTsk = Nothing 
    Set olApp = Nothing 

      MSG1 = MsgBox("Are BCP and BIA attached?", vbYesNo, "Yadda?") 

      If MSG1 = vbYes Then 
       myItem.Send 
      Else 
       MsgBox "Dude! What are you thinking??" 

       Dim myInspector As Outlook.Inspector 
       Set myolApp = CreateObject("Outlook.Application") 
       Set myInspector = myItem.GetInspector 
       Application.ActiveInspector.CommandBars.findcontrol(ID:=1079).Execute 

       Exit Sub 
       End If 

End Sub 

的代碼棒上：

Application.ActiveInspector.CommandBars.findcontrol(ID:=1079).Execute 

任何幫助將大大appriciated

Answer 1

更新/編輯：

由於「插入文件」按鈕呈灰色o當你在AppointmentItem表單的「Scheduling」頁面上時，在運行你的代碼之前切換到「Appointment」頁面。

作爲替代方案，您可以通過編程方式切換到「約會」頁面。

apptInspector.SetCurrentFormPage("Appointment")

原來的答案：

這是相關的代碼塊在我原來的答覆（見下文）使用代碼，試圖單擊「插入文件」按鈕之前調用SetCurrentFormPage Method ：

MsgBox "Dude! What are you thinking??"     
Dim myInspector As Outlook.Inspector     
Set myolApp = CreateObject("Outlook.Application")     
Set myInspector = myItem.GetInspector    
Application.ActiveInspector.CommandBars.FindControl(ID:=1079).Execute 

創建督察對象，並分配給它的AppointmentItem檢查，但不是使用該對象的的CommandBars。 FindControl方法，您可以使用ActiveInspector來代替。

既然你已經爲你創建的約會到Inspector參考，請嘗試更改

Application.ActiveInspector.CommandBars.FindControl(ID:=1079).Execute

到

myInspector.CommandBars.FindControl(ID:=1079).Execute

，看看是否可行。