Option Explicit
 
Sub Send_Mail()
    Dim objOutlookApp As Object, objMail As Object, Wb As Workbook
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
 
    Application.ScreenUpdating = False
    On Error Resume Next
    'пробуем подключитья к Outlook если он уже открыт
    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: Exit Sub
    
    sTo = "test1@mail.ru"    'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value)
    sSubject = "Автоотправка"    'Тема пиьма(можно заменить значением из ячейки - sSubject = Range("A2").Value)
    sBody = "Текст в теле письма"    'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value)
      'Вложение(Полный путь к файлу можно заменить значением из ячейки - sAttachment = Range("A4").Value)
    
     sAttachment = "C:\Кн.xls"
    ActiveSheet.Copy
    Set Wb = ActiveSheet.Parent
    Wb.SaveAs Filename:=sAttachment, _
              FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Wb.Close (False)
    
    
    'создаем сообщение
    With objMail
        .To = sTo 'адрес получателя
        .CC = "" 'адрес для копии
        .BCC = "" 'адрес для скрытой копии
        .Subject = sSubject 'тема сообщения
        .Body = sBody 'текст сообщения
        '.HTMLBody = sBody 'если необходимы форматированный текст сообщения(шрифты, цвет и т.п.)
        .Attachments.Add ActiveWorkbook.FullName  'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName
        .Send .Display ', если необходимо просмотреть сообщение, а не отправлять без просмотра
    End With
 
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub