☰

使用 vba 或其他方式在 Outlook 中为每个月的第三个工作日添加提醒

tag-icon • tag-icon microsoft-outlook-2010
使用 vba 或其他方式在 Outlook 中为每个月的第三个工作日添加提醒

有人能帮我在 Outlook 2010 中使用 vba 或其他方式为每月第三个工作日添加提醒吗？我只在 MS Outlook 2010 中尝试过，但没有成功。

我只希望将工作日（不是假日也不是周末）设置为提醒日期。Outlook 也选择周末，这是一个问题！

答案1

试试我为你编写的这个 VBa...请注意，我在英国，所以使用英国日期格式。下面的代码并非完全满足你的需求（尽管它确实能满足你的要求），但它也为你提供了一个起点，你可以根据需要进行调整。

Sub CreateEvent() 

 ' ====================     UPDATE THE DATES BELOW and add all the public holidays
    Dim publicHolidayDates(0 To 1) As Date
    publicHolidayDates(0) = "5 / 5 / 2014" ' this is used for demo purposes. The third working day of May is 5th - I've pretended 5th is bank holiday and as such, the event is entered on the 6th
    publicHolidayDates(1) = "01/01/2015"    

    Dim checking As Boolean
    checking = True

    ' ====================    ENTER THE STARTING DATE
    Dim myDate As Date
    myDate = "1 / 5 / 2014"

    Dim dayToCheck As String

    Dim dayResult As Integer

    Dim thirdDayYet As Integer
    thirdDayYet = 0

    Dim thirdMonthYet As Integer
    thirdMonthYet = 0

    ' ====================     How many months into the future do you want to add it too (start with 1 just to see it add it to next month)?
    Dim numberOfMonthsToAddReminderToo As Integer
    numberOfMonthsToAddReminderToo = 2

    Do While (checking)

        dayToCheck = Format(myDate, "dddd")

        If (LCase(dayToCheck) <> "saturday" And LCase(dayToCheck) <> "sunday") Then

            Dim canContinue As Boolean
            canContinue = True
            For i = 0 To UBound(publicHolidayDates)
                If publicHolidayDates(i) = myDate Then
                    canContinue = False
                    Exit For
                End If

            Next i
            If (canContinue = True) Then
                thirdDayYet = thirdDayYet + 1
            End If
        End If

        If (thirdDayYet = 3) Then
            SaveToCalender(myDate)
            thirdMonthYet = thirdMonthYet + 1
            thirdDayYet = 0
            myDate = "01/" & month(myDate) & "/" & Year(myDate)
            myDate = DateAdd("m", 1, myDate)
        End If

        If (thirdMonthYet = numberOfMonthsToAddReminderToo) Then
            checking = False
        End If

        myDate = DateAdd("d", 1, myDate)

    Loop

End Sub

Sub SaveToCalender(ByVal myDate As Date)

    Dim oApp As Outlook.Application
    Dim oNameSpace As NameSpace
    Dim oItem As AppointmentItem

    On Error Resume Next
    ' check if Outlook is running
    oApp = GetObject("Outlook.Application")
    If Err <> 0 Then
        'if not running, start it
        oApp = CreateObject("Outlook.Application")
    End If

    oNameSpace = oApp.GetNamespace("MAPI")

    oItem = oApp.CreateItem(olAppointmentItem)

    ' ====================     UPDATE THE DETAILS BELOW with the appointment details
    With oItem

        .Subject = "This is the subject"
        .Start = myDate & " 09:00:00"
        .Duration = "01:00"

        .AllDayEvent = False
        .Importance = olImportanceNormal
        .Location = "Optional"

        .ReminderSet = True
        .ReminderMinutesBeforeStart = "10"

    End With

    oItem.Save()

    oApp = Nothing
    oNameSpace = Nothing
    oItem = Nothing
End Sub

我添加了一些注释，以便您知道可以在哪里更新“您的代码”。希望一切都清楚。

上述内容可以大大改进，但它会让您开始行动。但是您需要注意，您输入的事件未同步 - 这意味着，让我们假装您想更改事件的主题。您必须手动为日历中的每个事件执行此操作。它不会自动更新。

以上内容经过快速测试，它添加了事件，但可能存在错误等，因此请自行检查:)

再说一次，在尝试添加 50 个条目之前，请先尝试添加 1 或 2 个条目，以确保它能达到您想要的效果！

答案2

Outlook 具有内置的此功能。

选择计划任务并单击“重复”按钮。

在右侧的框中，第二个选项包含“工作日”的下拉菜单。因此，您可以直接为每个月的第二个或第三个工作日设置重复提醒。

相关内容