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