Function SendEmailUsingOutlook(ByVal Email$, ByVal MailText$, Optional ByVal Subject$ = "", _
                               Optional ByVal AttachFilename As Variant) As Boolean
    

    On Error Resume Next: Err.Clear
    Dim OA As Object: Set OA = CreateObject("Outlook.Application")
    If OA Is Nothing Then MsgBox "Не удается запустит OUTLOOK для отправки почты", vbCritical: Exit Function
 
    With OA.CreateItem(0)   'Ñîçäàåì íîâîå ñîîáùåíèå
        .To = Email$: .Subject = Subject$: .Body = MailText$
        If VarType(AttachFilename) = vbString Then .Attachments.Add AttachFilename
        If VarType(AttachFilename) = vbObject Then    ' AttachFilename as Collection
            For Each file In AttachFilename: .Attachments.Add file: Next
        End If
        For i = 1 To 100000: DoEvents: Next    
        Err.Clear: .Send
        SendEmailUsingOutlook = Err = 0
    End With
    Set OutApp = Nothing
End Function

Sub Отправить_Письмо_из_Outlook_ЭО()
If MsgBox("Отправить уведомление ?", _
              vbYesNo) = vbYes Then res = SendEmailUsingOutlook("11111111@s11e.ru;11111v.ak@1111e.ru", "В журнале авторского надзора САПепкп5 произошли изменения", "Апккпкпкп»")
    If res Then Debug.Print "Письмо 1 отправлено успешно" Else Debug.Print "Ошибка отправки"
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)                           
If Not Intersect(Target, [h10:H11,L10:L11]) Is Nothing Then    'адресс ячейки
Application.EnableEvents = False
UserForm1.Show
Application.EnableEvents = True
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)                           
If Not Intersect(Target, [h10:H11,L10:L11]) Is Nothing Then    'адресс ячейки
Application.EnableEvents = False
UserForm1.Show
Application.EnableEvents = True
End If
End Sub