0

因此，我正在编写一些代码，该代码需要预约并从预约中创建一些任务，并在发送之前检查是否有附件。

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

我附上了下面的代码：

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

任何帮助将不胜感激

4

1 回答 1

0

更新/编辑：

由于在 AppointmentItem 表单的“Scheduling”页面上“Insert File”按钮是灰色的，因此在运行代码之前切换到“Appointment”页面。

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

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方法，你使用一个 fromActiveInspector代替。

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

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

至

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

看看这是否有效。

于 2012-06-07T16:10:56.267 回答