.Body = Cells(X, 5).Value & vbNewLine & vbNewLine & Others 'Текст

Sub Rio_OutLook_Time_Manager()

Dim olApp As Object  'Для обращений к приложению АутЛук
Dim NewX As Object   'Для создания объекта события
Dim Others As String 'Для работы со списком людей
Dim NewMan As Object 'Для добавления нового участника

Dim They             'Массив приглашенных
Dim R As Byte        'Обработка события
Dim X As Long        'Для перебора строк
Dim A As Long        'Для перебора участников
Dim H As Long        'Высота Таблицы

H = Cells(Rows.Count, 1).End(xlUp).Row
If H < 2 Then Exit Sub
Set olApp = CreateObject("Outlook.Application")

For X = 2 To H
    Select Case Cells(X, 1).Value
        Case "": R = 0
        Case "Собрание": R = 1
        Case "Встреча": R = 2
    End Select
    If R > 0 Then
        Set NewX = olApp.CreateItem(1)
        With NewX
            .MeetingStatus = R
            They = Split(Cells(X, 4).Value, ", ")
            Select Case R
                Case 1
                    For A = 0 To UBound(They)
                        Others = "<" & They(A) & ">"
                        Set NewMan = NewX.Recipients.Add(Others)
                        NewMan.Type = 1
                    Next A
                    Others = ""
                Case 2
                    Others = "Участники встречи:" & vbNewLine & vbNewLine
                    For A = 0 To UBound(They)
                        Others = Others & They(A) & vbNewLine
                    Next A
            End Select
            .Subject = Cells(X, 2).Value
            .Location = Cells(X, 3).Value
            .Body = Cells(X, 5).Value & vbNewLine & vbNewLine & Others 'Текст
            .Categories = Cells(X, 6).Value
            .Start = Cells(X, 7).Value + Cells(X, 8).Value
            .End = Cells(X, 9).Value + Cells(X, 10).Value
            If Cells(X, 11).Value = "Да" Then
                .ReminderSet = True
                .ReminderMinutesBeforeStart = Cells(X, 12).Value
            Else
                .ReminderSet = False
            End If
            Select Case R
                Case 1: .Send
                Case 2: .Save
            End Select
        End With
    End If
Next X

Set They = Nothing
Set NewMan = Nothing
Set NewX = Nothing
Set olApp = Nothing

End Sub