Добрый день, Есть рабочий код. Он закидывает задачи из таблиц ексель в отлук. Подскажите как сделать чтобы он закидывал задачи не в папку "Задачи" оутлука, а к примеру создавал свою папку по названию файла эксель,
| Код |
|---|
Sub OutTask_Manager()
'Автоматическое добавление задач в Outlook
'Сделал Роман "Rioran" Воронов (voronov_rv@mail.ru)
'Для пользователей форума www.excelworld.ru
Dim OutApp As Object 'Для обращений к приложению Outlook
Dim OutTsk As Object 'Для создания задачи в Outlook
Dim shtX As Worksheet 'Для обращения к конкретному листу
Dim X As Long 'Для перебора создаваемых задач
Set shtX = ThisWorkbook.Worksheets("Задачник")
X = 2
Do While shtX.Cells(X, 1).Value <> 0
Set OutApp = CreateObject("Outlook.Application")
Set OutTsk = OutApp.CreateItem(3)
With OutTsk
.Subject = shtX.Cells(X, 1).Value 'Заголовок задачи
.Body = shtX.Cells(X, 2).Value 'Текст задачи
.ReminderSet = True 'Включить напоминание
Select Case shtX.Cells(X, 3).Value 'Выбираем важность
Case "Низкая": .Importance = 0
Case "Обычная": .Importance = 1
Case "Высокая": .Importance = 2
End Select
.StartDate = DateAdd("h", 10, shtX.Cells(X, 4).Value) 'Когда начать задачу
.DueDate = DateAdd("h", 10, shtX.Cells(X, 5).Value) 'Дата завершения
.ReminderTime = DateAdd("n", shtX.Cells(X, 7).Value * 60 + shtX.Cells(X, 8).Value, shtX.Cells(X, 6).Value) 'Дата напоминания
.Save
End With
X = X + 1
Loop
Set OutApp = Nothing
Set OutTsk = Nothing
End Sub
|
