Function SendEmailUsingOutlook(ByRef SendMode As Variant, _
                 ByVal mailText$, _
                 ByVal email$, _
                 Optional ByVal copyTo$, _
                 Optional ByVal bopyTo$, _
                 Optional ByVal subject$ = "", _
                 Optional ByVal attachFileName As Variant, _
                 Optional ByVal dicHtmlFiles As Dictionary, _
                 Optional ByVal bDefaultSign As Boolean) _
                  As Boolean
    Application.StatusBar = "Send mail " & email$ & " " & subject$
    
    Dim oOutlook As Object
    On Error Resume Next: Err.Clear
    If oOutlook Is Nothing Then Set oOutlook = GetObject(, "Outlook.Application")
    If oOutlook Is Nothing Then
     Set oOutlook = CreateObject("Outlook.Application")
    End If
    If oOutlook Is Nothing Then CreateObject("WScript.Shell").Popup "Не удалось запустить OUTLOOK для отправки почты", 2, "SendEmailUsingOutlook", vbCritical: Exit Function
    Err.Clear
    
    On Error GoTo 0
    
    Dim file As Variant
    
    
    Dim bHTML As Boolean
    bHTML = (Not dicHtmlFiles Is Nothing)
    If bHTML = False Then
     bHTML = (InStr(mailText$, "</") <> 0)
    End If
     
     'создаем новое сообщение
     Dim oMail As Object 'Outlook.MailItem
     Set oMail = oOutlook.CreateItem(0)
     With oMail
      .To = email$: .subject = subject$
      .bcc = bopyTo$
      .CC = copyTo$
      
      .Display
      If bHTML Then
          If dicHtmlFiles Is Nothing Then
           .HTMLBody = mailText$ & String(1, Chr(13)) & .HTMLBody
          Else
           Dim j As Integer
           On Error Resume Next
            For j = dicHtmlFiles.Count - 1 To 0 Step -1
                file = dicHtmlFiles.Keys()(j)
                Select Case file
                Case ""
                Case Else
                 If fso.FileExists(file) Then
                  With fso.OpenTextFile(file, ForReading)
                       oMail.HTMLBody = .ReadAll & String(1, Chr(13)) & oMail.HTMLBody
                      .Close
                  End With
                  Kill file
                 End If
                End Select
            Next
           On Error GoTo 0
          End If
      Else
          .body = mailText$
      End If
      
      If VarType(attachFileName) = vbString Then .Attachments.Add attachFileName
      If VarType(attachFileName) = vbObject Then    ' AttachFilename as Collection
          For Each file In attachFileName.Keys: .Attachments.Add file: Next
      End If
      Dim i As Long: For i = 100000 To 100000: DoEvents: Next    ' без паузы не отправляются письма без вложений
      Err.Clear
      
      'Проверить имена
      Dim recipient As Object
      For Each recipient In .Recipients
          recipient.Resolve
      Next
      SendEmailUsingOutlook = Err = 0
     End With
    Application.StatusBar = False
End Function