Function SendMail(ByVal sTo As String, ByVal sSubject As String, ByVal FileNameXls As String)
'
' отправка письма
'
    Const CDO_Cnf = "http://schemas.microsoft.com/cdo/configuration/"
    Dim oCDOCnf As Object, oCDOMsg As Object, sMsg As String, sBody As String
    On Error Resume Next

    If Len(SMTPserver) = 0 Then MsgBox "Не указан SMTP сервер", vbInformation: Exit Function
    If Len(sUsername) = 0 Then MsgBox "Не указана учетная запись", vbInformation: Exit Function
    If Len(sPass) = 0 Then MsgBox "Не указан пароль", vbInformation: Exit Function

    'sBody = "Добрый день"    'Текст письма
    'Проверка наличия файла по указанному пути
    If Dir(FileNameXls, vbDirectory) = "" Then FileNameXls = ""
    'Назначаем конфигурацию CDO
    Set oCDOCnf = CreateObject("CDO.Configuration")
    With oCDOCnf.Fields
        .Item(CDO_Cnf & "sendusing") = 2
        .Item(CDO_Cnf & "smtpauthenticate") = 1
        .Item(CDO_Cnf & "smtpserver") = SMTPserver
        .Item(CDO_Cnf & "sendusername") = sUsername
        .Item(CDO_Cnf & "sendpassword") = sPass
        .Update
    End With
    'Создаем сообщение
    Set oCDOMsg = CreateObject("CDO.Message")
    With oCDOMsg
        Set .Configuration = oCDOCnf
        .BodyPart.Charset = "UTF-8"
        .From = sFrom
        .To = sTo
        .BCC = scopy
        .Subject = sSubject
        .TextBody = sBody
        .AddAttachment FileNameXls
        .Send
    End With
    
    Select Case Err.Number
    Case -2147220973: MsgBox "Нет доступа к Интернет _ " & sSubject
    Case -2147220975: MsgBox "Отказ сервера SMTP _ " & sSubject
    Case 0:
    Case Else: sMsg = "Ошибка номер: " & Err.Number & vbNewLine & "Описание ошибки: " & Err.Description: MsgBox sMsg & sSubject
    End Select
    Set oCDOMsg = Nothing: Set oCDOCnf = Nothing
End Function