Sub SendMail()

    Dim o_Mess As Object, v_Conf As String, email As String, i_Paht As String
    
    v_Conf = "http://schemas.microsoft.com/cdo/configuration/"
    i_Paht = reserv() ' указываем полный путь к файлу, который хотим вложить
    email = "....."   'e-mail получателя
    Set o_Mess = CreateObject("CDO.Message")    'Создаем сообщение
    With o_Mess
        .To = email   'Кому
        .From = "......"   'От кого
        .Subject = "Привет"   'Тема письма
        .TextBody = "Большой привет от VBA"   'Текст письма
        If Len(i_Paht) > 0 Then .AddAttachment i_Paht   'вкладываем файл
        With .Configuration.Fields   'конфигурируем CDO
            .Item(v_Conf & "sendusing") = 2
            .Item(v_Conf & "smtpserver") = "smtp.mail.ru" 'ваш сервер SMTP:smtp.mail.ru; smtp.yandex.ru; mail.rambler.ru
            .Item(v_Conf & "smtpauthenticate") = 1
            .Item(v_Conf & "sendusername") = "...." 'Ваша учетная запись
            .Item(v_Conf & "sendpassword") = "......." 'Ваш пароль к почтовому ящику
            .Item(v_Conf & "smtpserverport") = 465 'номер порта(узнать на сайте вашей почты)
            .Item(v_Conf & "smtpusessl") = True
            .Item(v_Conf & "smtpconnectiontimeout") = 60
            .Update
        End With
        .Send 'отправляем
    End With
    Set o_Mess = Nothing
End Sub

Function reserv() As String
Dim strPath As String
Dim strDate As String
    Application.ScreenUpdating = False
    strPath = ThisWorkbook.Path
    If Len(Dir(strPath & "\Резерв\", vbDirectory)) = 0 Then MkDir strPath & "\Резерв\"
    On Error Resume Next
    x = GetAttr(strPath) And 0
    If Err = 0 Then
        strDate = Format(Now, "dd.mm.yyyy hh-mm")
        FileNameXls = strPath & "\Резерв\" & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5) & " " & strDate & ".xlsb"
        ActiveWorkbook.SaveCopyAs Filename:=FileNameXls
        
          reserv = FileNameXls
    Else
       reserv = ""
    End If
    Application.ScreenUpdating = True
End Function