Outlook日历(VBA)中的Items.Restrict约会

时间:2017-12-21 11:33:41

标签: vba filter calendar outlook-vba appointment

我试图让日历中的所有约会在本月5日到下个月4日之间发生(包括那些日期发生的约会)。

以下是代码:

Private Sub Application_Startup()

    Dim oOL As New Outlook.Application
    Dim oNS As Outlook.NameSpace
    Dim oAppointments As Object
    Dim monthlyPats As Object
    Dim oAppointmentItem As Outlook.AppointmentItem

    'Set up date filter
    Dim sMth As Date
    Dim eMth As Date

    sMth = dhFirstDayInMonth() + 3 '4th of this month
    eMth = dhLastDayInMonth() + 4 '4th of next month

    Dim eDate As String
    eDate = "[End] < '" & eMth & "'"

    Dim sDate As String
    sDate = "[Start] > '" & sMth & "'"

    'Restrict tasks based on date filters
    Set oNS = oOL.GetNamespace("MAPI")
    Set oAppointments = Session.GetDefaultFolder(olFolderCalendar).Folders("Portfolio analysis scheduler").Items.Restrict(eDate)
    Set monthlyPats = oAppointments.Restrict(sDate)

End Sub

dhFirstDayInMonth()和dhLastDayInMonth()函数只是获取当前月份的第一天和最后一天。

我在2018年1月4日举办了两场比赛,一场是持续一整天的比赛,另一项是一整天的比赛。

不幸的是,只有经常发生的事件才能通过。如果我让它们都反复出现,那么它们都会被我们想要的monthPats捕获。

任何人都可以解释并提供这个问题的解决方案,因为它没有任何意义吗?

1 个答案:

答案 0 :(得分:0)

事实证明限制outlook中的项目可能是一场噩梦,我确保将IncludeRecurrences属性设置为True并按开始日期排序,这似乎可以解决问题。

另外,我让限制字符串同时执行两个作业,看起来更健壮了一些:

Private Sub Application_Startup()

    Dim oOL As New Outlook.Application
    Dim oNS As Outlook.NameSpace
    Dim allAppointments As Object
    Dim oAppointments As Object
    Dim monthlyPats As Object
    Dim oAppointmentItem As Outlook.AppointmentItem

    'Set up date filter
    Dim sMth As Date
    Dim eMth As Date

    sMth = dhFirstDayInMonth() + 3 '4th of this month
    eMth = dhLastDayInMonth() + 5 '5th of next month

    Dim rstDate As String
    rstDate = "[Start] > '" & sMth & "'" & " AND " & "[End] < '" & eMth & "'"

    'Restrict tasks based on date filters
    Set oNS = oOL.GetNamespace("MAPI")
    Set allAppointments = Session.GetDefaultFolder(olFolderCalendar).Folders("Portfolio analysis scheduler").Items
    allAppointments.IncludeRecurrences = True
    allAppointments.Sort "[Start]"

    Set monthlyPats = allAppointments.Restrict(rstDate)
    monthlyPats.IncludeRecurrences = True

End Sub