2

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

Я хочу, чтобы в качестве даты напоминания был установлен только рабочий день (не выходной и не выходные). Outlook тоже выбирает выходные, что является проблемой!

2 ответа2

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, чтобы убедиться, что он делает то, что вы хотите!

0

Outlook имеет встроенную функциональность для этого.

Выберите Schedule Task и нажмите кнопку "Повторение".

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

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .