*сохраняем диапазон с требуемой информаций в объектную переменную

Dim rnGAttach As Range 'имя объёктной переменной
Set rnGAttach = ThisWorkbook.Worksheets("Ваш лист").Range("B2:B34") 'вместо "ваш лист' укажите имя листа, с которого сохраняется диапазон ячеек в .Body 
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
    .To = ThisWorkbook.Sheets("Sheet2").Range("C1").Value 'Это если адрес получателя статичен / не запрашиваете у пользователя через форму / inbox или указывается непосредственно в книге
    .CC = ""
    .BCC = ""
    .Subject = "This is the Subject line" 'тема письма
    .HTMLBody = RangetoHTML(rnGAttach) 'тело письма. в данном случае это сохранённый нами в объектную переменную диапазон и сконвертированный в html удобоваримый формат
    .Display 'или .Send - чтобы отправить сразу
End With

.BodyFormat = 2

Dim adressTo$, fname$, theme$, Disclaimer$
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim rng As Range

Set sh = ThisWorkbook.Sheets("Для исполнения")

With Application
    .DisplayAlerts = False
    .EnableEvents = False
    .ScreenUpdating = False
End With

With sh
    .AutoFilterMode = False
    .Range("$A$1:$B$1").AutoFilter Field:=2, Criteria1:="<>"
End With

Set rng = sh.Range("A1").CurrentRegion

With sh
    adressTo = .Range("G2").Value
    theme = .Range("H2").Value
    Disclaimer = .Range("J2").Value
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next

With OutMail
    .To = adressTo
    .cc = ""
    .BCC = ""
    .Subject = theme
    .HTMLBody = "<p style=font-size:10pt;font-family:Calibri;>" & Disclaimer & _
        RangetoHTML(rng)
    .Display 'или Send - чтобы отправить сразу, без предварительного просмотра сформированного сообщения Outlook
End With

Set OutMail = Nothing
Set OutApp = Nothing
sh.AutoFilterMode = False
ThisWorkbook.Save

MsgBox "Письмо успешно сформировано и направлено! ", vbInformation, "Подтверждение отправки сообщения"

With Application
    .EnableEvents = True
    .ScreenUpdating = True
    .DisplayAlerts = True
End With

Fname = Application.GetOpenFilename( _
            FileFilter:="XLS Files (*.xls),*.xls,CSV Files (*.csv),*.csv", _
            Title:="Пожалуйста, выберите файл для вложения", _
            MultiSelect:=True)

.Body = Range("B2:B34")
'сама функция
Function GetAllText(rng As Range)
    Dim lr As Long, lc As Long, arr
    Dim res As String
    
    arr = rng.Value
    If Not IsArray(arr) Then
        ReDim arr(1 To 1, 1 To 1)
        arr(1, 1) = rng.Value
    End If
    For lr = 1 To UBound(arr, 1)
        For lc = 1 To UBound(arr, 2)
            If lc = 1 Then
                res = res & arr(lr, lc)
            Else
                res = res & vbTab & arr(lr, lc)
            End If
        Next
        res = res & vbNewLine
    Next
    GetAllText = res
End Function