如何在Outlook宏中过滤掉某些约会?

Question

我在工作中有太多的会议，所以我想我可以使用Outlook VBA宏来阻止我的日历，当我有太多的会议，所以我可以用剩下的时间来真正完成事情。

`Sub BlockMoreCalendarAppts()

Dim myAcct As Outlook.Recipient
Dim myFB As String
Dim tDate As Date
Dim d As Long
Dim i As Long
Dim test As String
Dim oAppt As AppointmentItem
' it needs to know whose FB to check
Set myAcct = Session.CreateRecipient("[e-mail]")
' days to check
For d = 0 To 5
tDate = Date + d
' use start of working day or there about
' false counts tenetive and oof as busy
myFB = myAcct.FreeBusy(tDate + #9:30:00 AM#, 5, False)
' this gets the # of 5 min periods before the start time
i = (TimeValue(tDate + #9:30:00 AM#) * 288)
' only count free busy for 7:10 hours from start + at least 1 additional 5 min period
' # of min in working day / 5
' skips busy times in the evening
test = Mid(myFB, i, 435 / 5)
CountOccurrences = UBound(Split(test, "1")) ' busy, oof or tentative
' theoretical WHERE statement goes here?

CountO = UBound(Split(test, "0")) ' free
'round to hours for subject
times = Round(((CountOccurrences * 5) / 60), 2)
' create all day busy event
' there are 12 5 minute periods per hour
' 60 = 5 hours
If CountOccurrences >= 60 Then
' default calendar
Set oAppt = Application.CreateItem(olAppointmentItem)
With oAppt
.Subject = times & " hours of appt today"
.Start = tDate
.ReminderSet = False
.Categories = "Full Day"
.AllDayEvent = True
.BusyStatus = olBusy
.Save
End With
End If
' check next day
Next d
End Sub`

逻辑是，如果我一天中有超过5个小时的会议，它就会设置一整天的约会，并将我标记为忙碌。

我测试了附加的宏，它可以工作，但是，我想过滤掉在主题中包含某些单词的约会。例如，"午餐";或";Focus"。换句话说，我不想要"午餐"。要算在我五个小时的会议里。

我还没有弄清楚如何使用WHERE函数来过滤当天的特定约会。如有任何帮助，不胜感激。

这是基于(很大程度上)Diane Poremsky在https://www.slipstick.com/outlook/calendar/limit-number-appointments-day/上的伟大工作

Answer 1

如果你切换到循环遍历约会那么你可以像这样把它们加起来吗?伪代码:

' Set the start and end times for the day
Dim startTime As Date
startTime = DateSerial(year, month, day) + TimeValue("9:00 AM")
Dim endTime As Date
endTime = DateSerial(year, month, day) + TimeValue("5:00 PM")
' Set the search criteria for the appointments
Dim filter As String
filter = "[Start] >= '" & startTime & "' AND [End] <= '" & endTime & "'" & _
"AND [Subject] NOT Like '*focus*'"
' Get the calendar folder for the default account
Dim calendarFolder As Folder
Set calendarFolder = Application.Session.GetDefaultFolder(olFolderCalendar)
' Set the current appointment to the first appointment of the day
Dim currentAppointment As AppointmentItem
Set currentAppointment = calendarFolder.Items.Find(filter)
' Loop through all appointments on the day
Do While Not (currentAppointment Is Nothing)
' Process the current appointment
' ...

' Get the next appointment
Set currentAppointment = calendarFolder.Items.FindNext
Loop