Vba 如何在添加与会者后将附件添加到AppointmentItem？

因此，我正在编写一段代码，它接受一个约会，从约会中创建一些任务，并在发送之前检查是否有附件

当我没有其他与会者时，代码工作正常。但一旦添加了与会者，代码就会在打开“文件附件”对话框时卡住。哎呀

我已附上以下代码：

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

---

任何帮助都将非常宝贵

更新/编辑：

由于当您在AppointItem表单的“Scheduling”页面上时，“Insert File”（插入文件）按钮变灰，请在运行代码之前切换到“Appointment”（约会）页面

或者，您可以通过编程方式切换到“约会”页面。使用我原始答案中的代码（见下文），在尝试单击“插入文件”按钮之前，请先调用：

apptInspector.SetCurrentFormPage（“约会”）

原始答案：

这是相关的代码块：

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

创建一个Inspector对象并将AppointItem Inspector指定给它，但不使用该对象的命令栏。方法，则使用来自

ActiveInspector

的方法

由于您对正在创建的约会的检查员有引用，请尝试更改

Application.ActiveInspector.CommandBars.FindControl（ID:=1079）。执行

到

myInspector.CommandBars.FindControl（ID:=1079）。执行

---

看看是否有效。

欢迎使用堆栈溢出。如果您只需要调试一行代码，请不要发布整个代码。这不关我的事，但是你的代码看起来需要进行重大的重构。首先，如果这是Outlook VBA，那么为什么要使用

New

关键字？甚至不少于六次。那里没有运气。真倒霉我只是不知道为什么添加一个收件人会导致它在这个问题上失火。我已经加入了一个debug.print的东西，并且知道检查员仍然保留着这个约会。啊哈！！！！因此，如果我在最初的约会页面上，代码似乎对收件人有效。但是如果我在“添加收件人”页面上单击我的小按钮，它将无法工作。我怀疑这是因为UI发生了变化，而“添加收件人”页面实际上是一个新的UI，因此没有被检查器选中！哎呀！