Sub Send_Mail()

    Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody1 As String, sBody2 As String, sBody3 As String, sTable As String, sAttachment As String, sCC As String
 
    Application.ScreenUpdating = False
    On Error Resume Next
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    
    Set objMail = objOutlookApp.CreateItem(0)
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
 
    sTo = Range("Q2").Value
    sCC = ""
    sSubject = Range("Q4").Value
    sBody1 = Range("C5").Value
    sBody2 = Range("C6").Value
    sBody3 = Range("C12").Value
    sTable = Range("C18:J22").Value
 
    With objMail
        .To = sTo
        .CC = ""
        .Subject = sSubject
        .body = sBody1
        .body = sBody2
        .body = sBody3
        .Table = sTable
        '.HTMLBody = sBody
        .Attachments.Add ActiveWorkbook.FullName
        .Display 'Send
    End With
 
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
    
MsgBox ("DONE")
End Sub