部分的に行われる予定のまたは特定の期間だけでは、予定表を検索します

Office 2013 and later

このトピックでは、Jet クエリを使用して、特定の開始時刻から終了時刻までの期間に発生する予定を既定の予定表フォルダーで検索する Visual Basic for Applications (VBA) の例を示します。このクエリは、この期間内に全体的に発生する予定、つまり、開始時刻以降に開始され、終了時刻以前に終了する予定を返します。また、この期間と重なる予定、つまり、期間が始まる前に開始され期間内に終了する予定、期間内に開始され期間が終わってから終了する予定、および開始時刻前に開始され終了時刻より後に終了する (期間全体と重なる) 予定も返します。返される結果には、定期的な予定が含まれます。

たとえば、開始日以降に開始され、終了日以前に終了する予定を照会するとします。これは、次のようなクエリになります。

コピー 
[Start] >= myStart AND [End] <= myEnd

しかし、この期間内に全体的に発生するすべての予定 "および" この期間と重なるすべての予定を確実に検索するには、期間の終了時刻以前に開始された予定、および期間の開始時刻以降に終了する予定を検索するクエリを使用する必要があります。これは、次のようなクエリになります。

コピー 
[Start] <= myEnd AND [End] >= myStart

特定の期間と重なる予定を考慮に入れるのは、その期間に発生するすべての予定を予定表から削除する場合に便利です。この場合、特定の期間内に開始および終了する予定を照会するだけでは十分ではありません。

サンプル コード内のFindApptsInTimeFrame関数は、 myStart、現在のシステム日付の午前 12時 00分として、開始時刻と終了時刻、 myEnd、開始時間の後の 5 日間としての割り当て、クエリを最初に期間を定義します。既定の予定表フォルダー内のすべての項目を取得します。定期的な予定をクエリに含めるには、 Items.IncludeRecurrencesをTrueに設定し、 AppointmentItem.Startプロパティによって、項目を並べ替えます。myStartとmyEnd、以前の開始および終了する予定のすべてのクエリを構築します。、 Items.Restrictメソッドを使用して既定の予定表フォルダー内のアイテムにクエリを適用し、次に、返されたすべての予定の開始時刻を出力します。

VBA
コピー 
Sub FindApptsInTimeFrame()
    Dim myStart As Date
    Dim myEnd As Date
    Dim oCalendar As Outlook.folder
    Dim oItems As Outlook.items
    Dim oResItems As Outlook.items
    Dim oAppt As Outlook.AppointmentItem
    Dim strRestriction As String
     
    myStart = Date
    myEnd = DateAdd("d", 5, myStart)
    Debug.Print "Start:", myStart
    Debug.Print "End:", myEnd
     
    Set oCalendar = Application.session.GetDefaultFolder(olFolderCalendar)
    Set oItems = oCalendar.items
     
    oItems.IncludeRecurrences = True
    oItems.Sort "[Start]"
     
    strRestriction = "[Start] <= '" & Format$(myEnd, "mm/dd/yyyy hh:mm AMPM") _
    & "' AND [End] >= '" & Format(myStart, "mm/dd/yyyy hh:mm AMPM") & "'"
    Debug.Print strRestriction
     
    'Restrict the Items collection
    Set oResItems = oItems.Restrict(strRestriction)
     
    For Each oAppt In oResItems
        Debug.Print oAppt.Start, oAppt.Subject
    Next
End Sub

サンプル

Sub FindAppts()

    Dim myStart As Date
    Dim myEnd As Date
    Dim oCalendar As Outlook.folder
    Dim oItems As Outlook.items
    Dim oItemsInDateRange As Outlook.items
    Dim oFinalItems As Outlook.items
    Dim oAppt As Outlook.AppointmentItem
    Dim strRestriction As String

    myStart = Date
    myEnd = DateAdd("d", 30, myStart)

    Debug.Print "Start:", myStart
    Debug.Print "End:", myEnd
         
    'Construct filter for the next 30-day date range
    strRestriction = "[Start] >= '" & Format$(myStart, "mm/dd/yyyy hh:mm AMPM") & _

            "' AND [End] <= '" & Format$(myEnd, "mm/dd/yyyy hh:mm AMPM") & "'"


    'Check the restriction string
    Debug.Print strRestriction
    Set oCalendar = Application.session.GetDefaultFolder(olFolderCalendar)
    Set oItems = oCalendar.items

 

    oItems.IncludeRecurrences = True  '定期的な予定（繰り返し）を含む場合は設定

 

    oItems.Sort "[Start]"    'Restrict the Items collection for the 30-day date range
    Set oItemsInDateRange = oItems.Restrict(strRestriction)

 

    '件名に「★○☆■」という文字列を含むアイテムを取得するフィルタを構成
    Const PropTag  As String = "http://schemas.microsoft.com/mapi/proptag/"
    strRestriction = "@SQL=" & Chr(34) & PropTag & "0x0037001E" & Chr(34) _

        & " like '%★○☆■%'"


    'Restrict the last set of filtered items for the subject
    Set oFinalItems = oItemsInDateRange.Restrict(strRestriction)

 

    'Sort and Debug.Print final results
    oFinalItems.Sort "[Start]"
    For Each oAppt In oFinalItems
        Debug.Print oAppt.Start, oAppt.Subject
    Next
End Sub

友だち追加