Додайте нагадування в прогнозі на кожен третій робочий день місяця, використовуючи vba чи іншим способом

Може хтось допоможе мені додати нагадування в прогнозі 2010 року на кожен третій робочий день місяця за допомогою vba чи іншим способом. Я спробував це лише в MS Outlook 2010, але успіху не було.

Я хочу лише, щоб робочий день (не святковий і не вихідний) був встановлений як нагадування. Outlook вибирає і вихідні дні, що є проблемою!

Спробуйте цей 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, щоб переконатися, що він робить те, що ви хочете!

Outlook має вбудовану функціональність для цього.

Виберіть Розклад завдань та натисніть кнопку «Повторити».

У кадрі праворуч другий варіант містить випадаюче меню "Тиждень". Таким чином, ви можете безпосередньо встановити нагадування про зайняття 2-го або 3-го тижня кожного місяця.