Sub save_in_pdf_and_send_email()
pdf_file = ThisWorkbook.Path & "" & ThisWorkbook.Name & ".pdf"      'файл ПДФ
ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdf_file, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
 
Dim objOutlookApp As Object, objMail As Object
Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
 
On Error Resume Next
Set objOutlookApp = GetObject(, "Outlook.Application")
Err.Clear 'Outlook закрыт, очищаем ошибку
If objOutlookApp Is Nothing Then
Set objOutlookApp = CreateObject("Outlook.Application")
End If
objOutlookApp.Session.Logon
Set objMail = objOutlookApp.CreateItem(0) 'создаем новое сообщение 'если не получилось создать приложение или экземпляр сообщения - выходим
If Err.Number <> 0 Then
    Set objOutlookApp = Nothing: Set objMail = Nothing
    MsgBox "Не удалось создать новое сообщение"
    Exit Sub
End If
 
sTo = InputBox("Введите получателей (если несколько то через ;)") '
sSubject = "Тема письма"
sBody = "Тело письма"
sAttachment = pdf_file
With objMail
    .To = sTo
    .CC = ""
    .BCC = ""
    .Subject = sSubject
    .Body = sBody
    .Attachments.Add sAttachment
    .Save
    .Send
End With
Set objOutlookApp = Nothing: Set objMail = Nothing
End Sub