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