Макрос для управления цепочками мелких задач в Outlook

Код макроса, который позволяет дробить задачу на подзадачи по строкам для их пошагового выполнения.

В MS Outlook нет встроенных средств для работы с проектами. Представим, что у вас есть проект отпуск, состоящий из трёх шагов:

После покупки билетов (первого шага) мы выбираем наш проект в списке задач Outlook и запускаем макрос. В результате первый шаг сохраняется в виде отдельной задачи и помечается выполненным и после #Project появляется новый хэштег с номером шага проекта #Step2.

Список задач после выполнения макроса:

Текст второй задачи:

Как установить?

Способ 1 - Скачать и импортировать модуль целиком (Alt+F11) - Task-Slicer.bas

Либо самостоятельно создать новый модуль со следующим VBA кодом функции, присваивающей номер шага:

Private Function NewSubject(InSubject As String, nextstep As Boolean) As String

Dim i As Long
Dim LastHTag, StepNumber As Integer
Dim FirstStep As Boolean

    LastHTag = 0
    FirstStep = True
    StepNumber = 1
    LastHTag = 1
NewSubject = InSubject

For i = 1 To Len(NewSubject)
    If Left(Right(NewSubject, Len(NewSubject) - i), 1) = "#" Then LastHTag = i + 1
Next i

If Mid(NewSubject, LastHTag + 1, 4) = "Step" Then FirstStep = False

Select Case FirstStep
Case True

    LastHTag = InStr(LastHTag, NewSubject, Chr(32))
    NewSubject = Left(NewSubject, LastHTag) & "#Step" & StepNumber & " " & Right(NewSubject, Len(NewSubject) - LastHTag)
    
Case False

    StepNumber = Int(Mid(NewSubject, LastHTag + 5, InStr(LastHTag, NewSubject, Chr(32)) - 5 - LastHTag))
    If nextstep = True Then StepNumber = StepNumber + 1
    NewSubject = Left(NewSubject, LastHTag + 4) & StepNumber & Right(NewSubject, Len(NewSubject) + 1 - InStr(LastHTag, NewSubject, Chr(32)))

End Select

End Function

И код, выполняющий все остальные действия:

Sub SelectedTask_NextStep()


Dim OlApp As Application
Dim objItem, NewTask As TaskItem

Dim TaskText As String
Dim Delimiter As Long

Set OlApp = Application


'//get selected/open task
'case - task not open
Set objItem = OlApp.ActiveExplorer.Selection.Item(1)
'case - task open
'Set objItem = objApp.ActiveInspector.CurrentItem

TaskText = objItem.Body
Delimiter = InStr(TaskText, Chr(10))
objItem.Body = Left(TaskText, Delimiter)
objItem.Subject = NewSubject(objItem.Subject, False)
objItem.Status = 2

Set NewTask = OlApp.CreateItem(olTaskItem)
 
    With NewTask

        .Subject = NewSubject(objItem.Subject, True)
        .DueDate = objItem.DueDate
        .Status = 1                 '0=not started, 1=in progress, 2=complete, 3=waiting,
                                    '4=deferred
        .Importance = 1             '0=low, 1=normal, 2=high
        .ReminderSet = False
        '.ReminderTime = dtReminderDate
        .Categories = objItem.Categories 'use any of the predefined Categorys or create your own
        .Body = Right(TaskText, Len(TaskText) - Delimiter)
        .Save   'use .Display if you wish the user to see the task form and make
                'them perform the save
    End With
End Sub

Для удобства можно создать пользовательскую вкладку с кнопкой в ленте.