Доброго времени суток. Необходимо решить следующую задачу. За указанный период (дата От и До) получить список всех задач из Outlook. Причем для повторяющихся должны быть указаны все отдельные экземпляры. Не могу придумать, как решить. Для встреч есть возможность использовать метод GetOccurance, который принимает дату и проверяет, есть ли на нее встреча. Для задач, к сожалению, метод не работает. Пока смог придумать только следующее: применять к задаче GetReccurancePattern, считывать параметры повторения и вычислять даты, на которые приходятся повторы. Затем сверять с нужными. Но варианты настройки повторений крайне разнообразные и прописать их все в коде выглядит задачей, как минимум, очень трудоемкой. Есть и еще вариант. При экспорте задач через Файл - Экспорт за указанный период выгружаются все повторения задачи в CSV. Может есть способ делать такой экспорт через VBA? (хотя, конечно, лучше в коде перебирать отдельные экземпляры повторений задачи).
Доброго времени суток. Необходимо решить следующую задачу. За указанный период (дата От и До) получить список всех задач из Outlook. Причем для повторяющихся должны быть указаны все отдельные экземпляры. Не могу придумать, как решить. Для встреч есть возможность использовать метод GetOccurance, который принимает дату и проверяет, есть ли на нее встреча. Для задач, к сожалению, метод не работает. Пока смог придумать только следующее: применять к задаче GetReccurancePattern, считывать параметры повторения и вычислять даты, на которые приходятся повторы. Затем сверять с нужными. Но варианты настройки повторений крайне разнообразные и прописать их все в коде выглядит задачей, как минимум, очень трудоемкой. Есть и еще вариант. При экспорте задач через Файл - Экспорт за указанный период выгружаются все повторения задачи в CSV. Может есть способ делать такой экспорт через VBA? (хотя, конечно, лучше в коде перебирать отдельные экземпляры повторений задачи).
Function GetRecTaskDates(dStart As Date, dEnd As Date, objTask As Object) 'Функция принимает объект "Задача" (TaskItem) из Outlook и две даты 'Возвращает даты повторения указанной задачи в указанном периоде дат
Dim objTempApnt As Object Dim objTaskPatt As Object Dim objTempPatt As Object Dim objCurApnt As Object Dim dCurDate As Date Dim arrResult() Dim iCount As Integer Dim n As Integer Dim lRecType As Long
'создали временную встречу Set objTempApnt = objTask.Application.CreateItem(olAppointmentItem) objTempApnt.Subject = "temp"
'считали шаблоны настроек повторения с исходной задачи и временной встречи Set objTempPatt = objTempApnt.GetRecurrencePattern Set objTaskPatt = objTask.GetRecurrencePattern
'перенесли шаблон повторения с задачи на временную встречу 'порядок переноса важен, переносимые настройки зависят от типа шаблона повторения OlRecurrenceType With objTempPatt .RecurrenceType = objTaskPatt.RecurrenceType lRecType = .RecurrenceType If objTaskPatt.DayOfMonth Then .DayOfMonth = objTaskPatt.DayOfMonth If lRecType = 1 Or lRecType = 3 Or lRecType = 6 Then .DayOfWeekMask = objTaskPatt.DayOfWeekMask .StartTime = #9:00:00 AM# .EndTime = #10:00:00 AM# .PatternStartDate = objTaskPatt.PatternStartDate If objTaskPatt.Interval Then .Interval = objTaskPatt.Interval If objTaskPatt.NoEndDate Then .NoEndDate = objTaskPatt.NoEndDate Else .Occurrences = objTaskPatt.Occurrences .PatternEndDate = objTaskPatt.PatternEndDate End If If lRecType >= 5 Then .MonthOfYear = objTaskPatt.MonthOfYear If lRecType = 3 Or lRecType = 6 Then .Instance = objTaskPatt.Instance End With
'сохранили встречу objTempApnt.Save
'перебираем все даты нужного периода, и если на дату есть встреча - переносим дату в массив For dCurDate = dStart To dEnd On Error Resume Next Set objCurApnt = objTempPatt.GetOccurrence(dCurDate + objTempPatt.StartTime) If Err.Number = 0 Then n = n + 1 ReDim Preserve arrResult(1 To n) arrResult(n) = dCurDate End If Err.Clear Next dCurDate On Error GoTo 0
Function GetRecTaskDates(dStart As Date, dEnd As Date, objTask As Object) 'Функция принимает объект "Задача" (TaskItem) из Outlook и две даты 'Возвращает даты повторения указанной задачи в указанном периоде дат
Dim objTempApnt As Object Dim objTaskPatt As Object Dim objTempPatt As Object Dim objCurApnt As Object Dim dCurDate As Date Dim arrResult() Dim iCount As Integer Dim n As Integer Dim lRecType As Long
'создали временную встречу Set objTempApnt = objTask.Application.CreateItem(olAppointmentItem) objTempApnt.Subject = "temp"
'считали шаблоны настроек повторения с исходной задачи и временной встречи Set objTempPatt = objTempApnt.GetRecurrencePattern Set objTaskPatt = objTask.GetRecurrencePattern
'перенесли шаблон повторения с задачи на временную встречу 'порядок переноса важен, переносимые настройки зависят от типа шаблона повторения OlRecurrenceType With objTempPatt .RecurrenceType = objTaskPatt.RecurrenceType lRecType = .RecurrenceType If objTaskPatt.DayOfMonth Then .DayOfMonth = objTaskPatt.DayOfMonth If lRecType = 1 Or lRecType = 3 Or lRecType = 6 Then .DayOfWeekMask = objTaskPatt.DayOfWeekMask .StartTime = #9:00:00 AM# .EndTime = #10:00:00 AM# .PatternStartDate = objTaskPatt.PatternStartDate If objTaskPatt.Interval Then .Interval = objTaskPatt.Interval If objTaskPatt.NoEndDate Then .NoEndDate = objTaskPatt.NoEndDate Else .Occurrences = objTaskPatt.Occurrences .PatternEndDate = objTaskPatt.PatternEndDate End If If lRecType >= 5 Then .MonthOfYear = objTaskPatt.MonthOfYear If lRecType = 3 Or lRecType = 6 Then .Instance = objTaskPatt.Instance End With
'сохранили встречу objTempApnt.Save
'перебираем все даты нужного периода, и если на дату есть встреча - переносим дату в массив For dCurDate = dStart To dEnd On Error Resume Next Set objCurApnt = objTempPatt.GetOccurrence(dCurDate + objTempPatt.StartTime) If Err.Number = 0 Then n = n + 1 ReDim Preserve arrResult(1 To n) arrResult(n) = dCurDate End If Err.Clear Next dCurDate On Error GoTo 0