在日历中搜索某个时间段内的约会 [英] Search the calendar for appointments in a time period

问题描述

我有一个 Excel 宏，可以按日期过滤日历约会.我使用了 Microsoft Docs 提供的代码，但它不起作用.我想迭代默认日历以查找将在今天和今天起 30 天内发生的约会.

这是代码:

<预><代码>Option Explicit ' 认为这是强制性的' 工具 |选项 |编辑器选项卡' 需要变量声明' 如果绝望声明为 Variant子 P1()将 oOutlook 变暗为对象变暗为对象Dim oAppointments 作为对象Dim oFilterAppointments 作为对象将 oAppointmentItem 作为对象变暗Dim bOutlookOpened As Boolean常量 olFolderCalendar = 9Dim sFilter 作为字符串Dim dateEnd As String出错时继续下一步Set oOutlook = GetObject(, "Outlook.Application") '绑定到现有的 Outlook 实例如果 Err.Number <>0 然后'无法获得 Outlook 的实例，因此创建一个新的错误清除Set oOutlook = CreateObject(Outlook.Application")bOutlookOpened = False 'Outlook 尚未运行，我们必须启动它别的bOutlookOpened = True 'Outlook 已经在运行万一设置 oNS = oOutlook.GetNamespace("MAPI")设置 oAppointments = oNS.GetDefaultFolder(olFolderCalendar)oAppointments.Sort [开始]oAppointments.IncludeRecurrences = TruedateEnd = DateAdd("d", 30, 日期)sFilter = "[开始] > = '";&日期 &"'AND [开始] <= '";&日期结束 &"Debug.Print sFilter设置 oFilterAppointments = oAppointments.Items.Restrict(sFilter)'遍历日历中的每个应用程序对于 oFilterAppointments 中的每个 oAppointmentItemDebug.Print oAppointmentItem.Start下一个结束子

今天的过滤器限制是 [Start] >= '03/02/2021 'AND [Start] <='14/05/2021但找到的第一个约会来自 2019 年.它返回的最后一个约会符合过滤器 (13/05/2021).我尝试了过滤器的不同变体，但它总是返回与 2019 年相同的约会.

解决方案

我看到一个小的日期差异，因此您的方案可能会有更多差异.

.Sort 在 .Restrict 之前.

Option Explicit ' 认为这是强制性的' 工具 |选项 |编辑器选项卡' 需要变量声明' 如果绝望声明为 Variant子 P1()将约会作为项目变暗Dim oFilterAppointments 作为项目将 oAppointmentItem 变暗为 AppointmentItemDim sFilter 作为字符串昏暗日期结束日期设置 oAppointments = Session.GetDefaultFolder(olFolderCalendar).Items' .Sort 在 .Restrict 之前o约会.排序[开始]"；oAppointments.IncludeRecurrences = TruedateEnd = DateAdd("d", 30, 日期)sFilter = "[开始] > = '";&日期 &"'AND [开始] <= '";&日期结束 &"Debug.Print sFilter设置 oFilterAppointments = oAppointments.Restrict(sFilter)'遍历过滤的约会对于 oFilterAppointments 中的每个 oAppointmentItemDebug.Print oAppointmentItem.Start下一个结束子

I have an Excel macro that filters calendar appointments by dates. I have used the code given by Microsoft Docs, but it does not work. I want to iterate the default calendar to find appoints that will occur between today and 30 days from today.

This is the code:

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant

Sub P1()
    Dim oOutlook              As Object
    Dim oNS                   As Object
    Dim oAppointments         As Object
    Dim oFilterAppointments   As Object
    Dim oAppointmentItem      As Object
    Dim bOutlookOpened        As Boolean
    Const olFolderCalendar = 9
    
    Dim sFilter As String
    Dim dateEnd As String
        
    
    On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")    'Bind to existing instance of Outlook
    If Err.Number <> 0 Then    'Could not get instance of Outlook, so create a new one
        Err.Clear
        Set oOutlook = CreateObject("Outlook.Application")
        bOutlookOpened = False    'Outlook was not already running, we had to start it
    Else
        bOutlookOpened = True    'Outlook was already running
    End If
 
    Set oNS = oOutlook.GetNamespace("MAPI")
    Set oAppointments = oNS.GetDefaultFolder(olFolderCalendar)
    
    oAppointments.Sort [Start]

    oAppointments.IncludeRecurrences = True
    
    
    dateEnd = DateAdd("d", 30, Date)
   
    sFilter = "[Start] >= '" & Date & " 'AND [Start] <= '" & dateEnd & "'"

    Debug.Print sFilter


    Set oFilterAppointments = oAppointments.Items.Restrict(sFilter)

    
    'Iterate through each appt in our calendar
    For Each oAppointmentItem In oFilterAppointments
        Debug.Print oAppointmentItem.Start

    Next


End Sub

The filter restriction for today is [Start] >= '03/02/2021 'AND [Start] <= '14/05/2021 but the first appointment that finds is from 2019. The last appointment that it returns fits the filter (13/05/2021). I have tried different variations of the filter but it always returns the same appointments of 2019.

解决方案

I see a small date discrepancy so there may be more to your scenario.

.Sort before .Restrict.

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant

Sub P1()
    
    Dim oAppointments         As Items
    Dim oFilterAppointments   As Items
    Dim oAppointmentItem      As AppointmentItem
    
    Dim sFilter As String
    Dim dateEnd As Date
    
    Set oAppointments = Session.GetDefaultFolder(olFolderCalendar).Items
    
    ' .Sort before .Restrict
    oAppointments.Sort "[Start]"
    oAppointments.IncludeRecurrences = True
    
    dateEnd = DateAdd("d", 30, Date)
    sFilter = "[Start] >= '" & Date & " 'AND [Start] <= '" & dateEnd & "'"
    Debug.Print sFilter

    Set oFilterAppointments = oAppointments.Restrict(sFilter)
   
    'Iterate through filtered appointments
    For Each oAppointmentItem In oFilterAppointments
        Debug.Print oAppointmentItem.Start
    Next
    
End Sub

这篇关于在日历中搜索某个时间段内的约会的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！