Sub Send_Mail()
 Dim oMail As Outlook.MailItem, OutlookApp As Outlook.Application
 Dim li As Long, sSignature As String
 Workbooks.OpenText "C:\Documents and Settings\USERPROFILE\Application Data\Microsoft\Signatures\Служебная.txt"
 For li = ActiveSheet.UsedRange.Row To ActiveSheet.UsedRange.Rows.Count
 sSignature = sSignature & vbCrLf & Cells(li, ActiveSheet.UsedRange.Column)
 Next li
 Set OutlookApp = Outlook.Application
 Set oMail = OutlookApp.CreateItem(0)
 With oMail
 .To = "aaa@bbb.ru"
 .Subject = "Тема"
 .Body = "Текст письма" & String(4, vbCrLf) & sSignature
 .Attachments.Add 'здесь указывается полный путь к файлу для отправки
 .Send 'Либо Display, если необходимо просто отобразить созданное письмо, но пока не отправлять - отправка возлагается на человека.

 End With
 Set oMail = Nothing
 Set OutlookApp = Nothing
End Sub

Sub Проверка()
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$3:$B$3").AutoFilter Field:=2, Criteria1:="<>" ' диапазон таблицы
End With

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

With sh
    adressTo = .Range("O3").Value ' получатель сообщения
    adressCC = .Range("O4").Value ' получатели копии сообщения
    theme = "согласование" & .Range("A4").Value & " " & .Range("T4").Value & " " & .Range("T5").Value & " " & .Range("T6").Value & " " & .Range("T7").Value & " " & .Range("T8").Value & " " & .Range("T9").Value & " " & .Range("T10").Value & " " & .Range("T11").Value & " " & .Range("T12").Value & " " & .Range("T13").Value & " " & .Range("T14").Value & " " & .Range("T15").Value & " " & .Range("T16").Value & " " & .Range("T17").Value & " " & .Range("T18").Value & " " & .Range("T19").Value & " " & .Range("T20").Value & " " & .Range("T21").Value & " " & .Range("T22").Value & " " & .Range("T23").Value & " " & .Range("T24").Value ' тема сообщения
    Disclaimer = .Range("P3").Value ' текст сообщения
End With

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

With OutMail
    .To = adressTo ' получатель сообщения
    .CC = adressCC ' получатели копии сообщения
    .BCC = ""
    .Subject = theme ' тема сообщения
    .HTMLBody = "<p style=font-size:11pt;font-family:Calibri;>" & Disclaimer & _
    RangetoHTML(rng) & vbCrLf & "<p style=font-size:11pt;font-family:Calibri;></a>"
    .Display

End With

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


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

End Sub