将自定义公司假期添加到个人日历，而无需创建重复条目-解网

问：

我完全改变了剧本。但是，当运行多次时，它现在会为所有定义的日期创建重复的日历条目。不知道为什么它没有在每个特定的日历日找到重复的主题。

Const olFolderCalendar = 9
Const olAppointmentItem = 1
Const olOutOfOffice = 3
CRLF = Chr(13) & Chr(10)

' Initialize Outlook
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar)
Set objDictionary = CreateObject("Scripting.Dictionary")

' Add holiday entries (modify as needed)
objDictionary.Add DateSerial(2023, 11, 23), "Thanksgiving Day"
objDictionary.Add DateSerial(2023, 11, 24), "Day After Thanksgiving Day"
objDictionary.Add DateSerial(2023, 12, 25), "Christmas Day"
objDictionary.Add DateSerial(2024, 1, 1), "New Years Day"
objDictionary.Add DateSerial(2024, 1, 15), "Martin Luther King Day"
objDictionary.Add DateSerial(2024, 5, 27), "Memorial Day"
objDictionary.Add DateSerial(2024, 7, 4), "Independence Day"
objDictionary.Add DateSerial(2024, 11, 28), "Thanksgiving Day"
objDictionary.Add DateSerial(2024, 11, 29), "Day After Thanksgiving Day"
objDictionary.Add DateSerial(2024, 12, 25), "Christmas Day"
objDictionary.Add DateSerial(2025, 1, 1), "New Years Day"

' Iterate through the dictionary
For Each dtmHolidayDate In objDictionary.Keys
    strHolidayName = objDictionary.Item(dtmHolidayDate)

    ' Check if an appointment with the same subject already exists
    Set objExistingHoliday = objCalendar.Items.Find("[Subject] = '" & strHolidayName & "' AND [Start] = '" & Month(dtmHolidayDate) & "/" & Day(dtmHolidayDate) & "/" & Year(dtmHolidayDate) & "'")
    If objExistingHoliday Is Nothing Then
        ' Create a new appointment item
        Set objHoliday = objOutlook.CreateItem(olAppointmentItem)
        With objHoliday
            .Subject = strHolidayName
            .Start = dtmHolidayDate
            .End = dtmHolidayDate
            .Categories = "Company Holidays"
            .AllDayEvent = True
            .ReminderSet = False
            .BusyStatus = olOutOfOffice
            .Save
        End With
    End If
Next

VBA Outlook 日历

我很惊讶它完全有效 - 您将日期存储为字符串，并且您需要将日期存储为日期，无论是在字典中还是在设置 and 属性时。那么问题来了，就是找不到预约？还是检查失败？在后一种情况下，您应该仅将截断到日期部分的值与字典中的日期（需要是日期，而不是字符串）进行比较。您真的不应该将 Date 与字符串进行比较（VBA 会将它们都转换为字符串），并且必须适当截断日期（仅限日期？） - 是一个浮点值，并且由于截断，比较将失败。StartEndobjCalendar.Items.FindobjExistingHoliday.Start <> dtmHolidayDateobjExistingHoliday.StartDateTime=

将自定义公司假期添加到个人日历，而无需创建重复条目

Add custom company holidays to personal calendars without creating duplicate entries

评论

评论