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メソッドを使用する場合は、ActiveInspector代わりに からのものを使用します。

作成している予定のインスペクターへの参照があるため、変更してみてください

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

に

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

それが機能するかどうかを確認します。

于 2012-06-07T16:10:56.267 に答える