通过

在日历中搜索主题中包含特定字词的日期范围内的约会

  • 项目

本主题显示了一个 Visual Basic for Applications (VBA) 代码示例，该示例在默认日历中查找在随后 30 天内发生且主题中包含“team”一词的约会。 返回的结果包括定期约会。

FindAppts代码示例中的函数使用两个不同的查询执行搜索，首先搜索约会，包括日期范围内开始和结束的定期约会，然后在符合主题中具有“团队”的日期范围条件的约会之间搜索。 以下是各个步骤的概述：

  1. FindAppts 首先定义要查询的时间段， myStart将开始时间 指定为当前系统日期的 12：00am，并将结束时间指定为开始时间 myEnd后的 30 天。

  2. 该示例获取默认日历文件夹中的所有项目。

  3. 为了包括完全处在该日期范围内的所有约会项目（包括定期约会），该示例将 Items.IncludeRecurrences 设置为 True ，然后按照 AppointmentItem.Start 属性对项目进行排序。

  4. 它为从 开始或 之后、在 或 之前myStartmyEnd结束的所有约会生成第一个查询。 此查询为 Jet 查询。

  5. 该示例使用 Items.Restrict 方法对默认日历文件夹中的项目应用该查询。

  6. 该示例生成第二个查询，搜索主题中包含"team"一词的约会。 它使用 like 关键字在 DAV 搜索和定位 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 支持和反馈，获取有关如何接收支持和提供反馈的指南。