搜尋行事曆中在日期範圍內且主旨包含特定文字的約會

本主題說明 Visual Basic for Applications (VBA) 中的程式碼範例，在預設行事曆中尋找嚴格在接下來三十天發生的約會，以及在主旨中包含「小組」文字的約會。 傳回的結果會包含週期性約會。

程式 FindAppts 代碼範例中的 函式會使用兩個不同的查詢來執行搜尋，先搜尋約會，包括在日期範圍內開始和結束的週期性約會，然後在符合主題中具有「team」 之日期範圍準則的約會之間搜尋。 以下是步驟大綱：

1. FindAppts 會先定義要查詢的時間週期，將開始時間 myStart 指派為目前系統日期的上午 12：00，並將結束時間指派為開始時間 myEnd 後的 30 天。

2. 它還會取得預設行事曆資料夾中所有的項目。

3. 為了包含正好在日期範圍內的所有約會 (包括週期性約會)，它會將 Items.IncludeRecurrences 設定為 True ，然後依 AppointmentItem.Start 屬性來排序項目。

4. 它會針對在 或 之後 myStart 開始，並在 或之前 myEnd 結束的所有約會，建置第一個查詢。 此查詢是 Jet 查詢。

5. 它會使用 Items.Restrict 方法，將查詢套用至預設行事曆資料夾中的項目。

6. 接著它會建立第二個查詢，來找出主旨中包含 "team" 文字的約會。 它會在 DAV 搜尋中使用 like 關鍵字進行子字串比對，並尋找 (DASL) 查詢。

7. 它會針對第一個查詢所傳回符合日期範圍準則的約會集，來套用第二個查詢。

8. 然後它會排序及列印所有最後傳回之約會的開始時間。

請注意，如果您想要包含重迭且不完全落在特定日期範圍內的約會專案，您應該將第一個查詢變更為在 或之前 myEnd 開始約會，並在 或之後 myStart 結束。 如需詳細資訊，請參閱操作方法：搜尋行事曆，找出部分或完全在指定期間內發生的約會。

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)
    'Construct filter for Subject containing 'team'
    Const PropTag  As String = "https://schemas.microsoft.com/mapi/proptag/"
    strRestriction = "@SQL=" & Chr(34) & PropTag _
        & "0x0037001E" & Chr(34) & " like '%team%'"
    '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

支援和意見反應

有關於 Office VBA 或這份文件的問題或意見反應嗎？ 如需取得支援服務並提供意見反應的相關指導，請參閱 Office VBA 支援與意見反應。