Sub auto()
Dim objOutlookApp As Object, objMail As Object
Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
Dim lr As Long, lLastR As Long
Application.ScreenUpdating = False
On Error Resume Next
Set objOutlookApp = GetObject(, "Outlook.Application")
If objOutlookApp Is Nothing Then
Set objOutlookApp = CreateObject("Outlook.Application")
End If
If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
objOutlookApp.Session.Logon
Calculate
lLastR = Cells(Rows.Count, 1).End(xlUp).Row
For lr = 2 To lLastR
Set objMail = objOutlookApp.CreateItem(0)
With objMail
.to = Cells(lr, 19).Value
.Subject = Cells(lr, 1).Value & " " & Cells(lr, 3).Value & " текст"
.Body = "Текст." & vbNewLine _
& vbNewLine _
& Текст " & Cells(lr, 3) & " Текст " & Cells(lr, 20).Value & " (ìñê) " & Cells(lr, 21).Value & " текст " & Round(Cells(lr, 5), 2) & " текс." & vbNewLine _
& vbNewLine _
& "Текст" & Round(Cells(lr, 12), 2) & " текст." & vbNewLine _
& vbNewLine _
& "текст" & Round(Cells(lr, 14), 2) & "текст " & vbNewLine _
& vbNewLine _
& "Текст" & vbNewLine _
& "Текст" _
& " Текст." & vbNewLine _
& "Текст" & vbNewLine _
& "Текст"
.Send
End With
Next lr
Set objOutlookApp = Nothing: Set objMail = Nothing
Application.ScreenUpdating = True
End Sub
