Sub send_email()
Dim olApp As Object

Dim olMailItm As Object
Dim iCounter As Integer
Dim Dest As Variant
Dim SDest As String
' e-mail subject
strSubj = "Окончание срока сертификата (название компании)"
On Error GoTo dbg
' creating odject for Outlook
Set olApp = CreateObject("Outlook.Application")
For iCounter = 1 To WorksheetFunction.CountA(Columns(1))
' creating new element (email message) in Outlook
Set olMailItm = olApp.CreateItem(0)
strBody = ""
useremail = Cells(iCounter, 1).Value
FullUsername = Cells(iCounter, 2).Value
Status = Cells(iCounter, 4).Value
pwdchange = Cells(iCounter, 3).Value
' body of the email
strBody = "Вас приветствует команда (название компании)!" & vbCrLf
strBody = strBody & "   " & vbCrLf
strBody = strBody & "Приглашаем на сервисное обучение (тело письма) " & vbCrLf
strBody = strBody & " Дата окончания действия сертификата " & pwdchange & vbCrLf
strBody = strBody & " Надеемся на дальнейшее сотрудничество! " & vbCrLf
strBody = strBody & "   " & vbCrLf
strBody = strBody & "---" & vbCrLf
strBody = strBody & ""
strBody = strBody & "Best regards," & vbCrLf
strBody = strBody & ""
strBody = strBody & " " & vbCrLf
strBody = strBody & ""
strBody = strBody & "Andrew " & vbCrLf
strBody = strBody & ""
strBody = strBody & "Tel.: +7" & vbCrLf
strBody = strBody & ""
strBody = strBody & "Tel: +7  (Moscow)" & vbCrLf
olMailItm.To = useremail
olMailItm.Subject = strSubj
olMailItm.BodyFormat = 1
' 1 - text format of letter, 2 - HTML format
olMailItm.Body = strBody
olMailItm.Attachments.Add "C:\Users\Desktop\УНО\Cервисное обучение на I-квартал 2023 год.pdf"
olMailItm.Save
olMailItm.Send
' etu strochku mojno ispolzovat dlia otkladki pisma
'MsgBox strBody
Set olMailItm = Nothing
Next iCounter
Set olApp = Nothing
dbg:
'errors,if yes
If Err.Description <> "" Then MsgBox Err.Description
End Sub