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

任何帮助都会非常适合

Answer 1

<强>更新/编辑：

由于当您在AppointmentItem表单的“Scheduling”页面上时，“Insert File”按钮显示为灰色，请在运行代码之前切换到“Appointment”页面。

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

apptInspector.SetCurrentFormPage("Appointment")

原始答案：

这是相关的代码块：

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对象并为其分配AppointmentItem检查器，但不是使用该对象的CommandBars。FindControl方法，而是使用ActiveInspector中的那个。

由于您要为正在创建的约会引用Inspector，请尝试更改

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

到

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

看看是否有效。

如何在添加与会者后向AppointmentItem添加附件？

1 个答案: