Отправка писем из Excel-я через Outlook - VBA

Формулировка задачи:

Всем доброго времени суток. Очень большая просьба помочь доделать. Есть макрос для отправки писем из икселя через оутлук с вложением текущего файла. Возможно ли внести исправление, чтобы не вкладывался файл, а из него в тело письма вставлялись только выделенные ячейки?

Sub Send_Mail()
Dim objOutlookApp As Object, objMail As Object
Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
Dim sCc As String
Application.ScreenUpdating = False
On Error Resume Next
Set objOutlookApp = CreateObject("Outlook.Application")
objOutlookApp.Session.Logon
Set objMail = objOutlookApp.CreateItem(0) 
If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
 
sTo = "***@***.ru" 
sCc = "***@***.ru " 
sSubject = "отчет" 
sBody = "Добрый день," & "<BR>" & "Отчётные данные:"
(вставка из таблицы)
 
With objMail
.To = sTo 
.Cc = sCc 
.Subject = sSubject 
.HTMLBody = sBody 
 
.Display End With
exit_:
Set objOutlookApp = Nothing: Set objMail = Nothing
Application.ScreenUpdating = True
End Sub

Всем заранее спасибо!

Решение задачи: «Отправка писем из Excel-я через Outlook»

textual
                            Листинг программы 
                        

                            #If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As LongPtr) As LongPtr
    #Else
        Private Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As LongPtr) As LongPtr
    #End If
#Else
    #If Win64 Then
        Private Declare PtrSafe Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As LongLong) As LongLong
    #Else
        Private Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long
    #End If
#End If
 
Sub aaaa11111Send_Mail()
Dim objOutlookApp As Object, objMail As Object
Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
Dim sCc As String
Application.ScreenUpdating = False
Dim wbkX As Workbook
    Dim shtX As Worksheet
    Dim rngBody As Range
    Dim rngCell As Range
    On Error Resume Next
    LoadKeyboardLayout "0000419", &H1
     Set wbkX = ActiveWorkbook
    Set shtX = wbkX.Sheets(1)
    wbkX.Activate
    Set rngBody = Selection
    Selection.Copy
    Set objOutlookApp = CreateObject("Outlook.Application")
objOutlookApp.Session.Logon
Set objMail = objOutlookApp.CreateItem(0)
If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
 sTo = "***@***.ru"
sCc = "***@***.ru"
sSubject = "отчет"
sBody = "Добрый день," & "<BR>" & "Отчётные данные:"
With objMail
.To = sTo
.CC = sCc
.Subject = sSubject
.HTMLBody = sBody
.Display
SendKeys ("^{END}")
SendKeys ("{ENTER}{ENTER}")
'SendKeys ("~ ~")
SendKeys "^v", True
 End With
exit_:
Set objOutlookApp = Nothing: Set objMail = Nothing
Application.ScreenUpdating = True
End Sub
                        