На форуме мне посоветовали мспользовать очень хорошую ссылку
http://www.sql.ru/forum/463376/excel-outlook-otpravka-v-tele-pisma-tablicy

Private Sub Отправить_Email()
'Процедура отправки таблицы в теле письма:
Dim mailApp As Outlook.Application
Dim dfg As Object
Dim n As Integer
Dim WB As Workbook

Set ExcelApp = CreateObject("Excel.Application")
Set WB = ExcelApp.Workbooks.Open("G:\103_01_Proba.xls")

WB.Application.Visible = True

'поиск окна Microsoft Outlook
lngRetVal = FindWindowByClass("rctrl_renwnd32", 0&)
If lngRetVal <> 0 Then
Set mailApp = GetObject(, "Outlook.Application")
Else
Set mailApp = CreateObject("Outlook.Application")
End If
Set objMail = mailApp.CreateItem(olMailItem)
Set dfg = objMail.Recipients.Add("vlad_cher@mail.ru")
dfg.Type = olTo

With objMail
.Importance = olImportanceHigh
.Subject = "Передача таблицы"
.BodyFormat = olFormatHTML 'формат HTML
.HTMLBody = SheetToHTML(WB.Worksheets("Аттестация"))
End With

'Предварительный просмотр письма
objMail.Display
'Отправка письма
' objMaib.Send
' Закрыть книгу
ActiveWorkbook.Close Fal
ExcelApp.Application.Quit

Set WB = Nothing
Set ExcelApp = Nothing
Set objMail = Nothing
Set mailApp = Nothing
End Sub

'"Функция-хак" псевдопреобразования таблицы в набор html'ных тегов для BODY письма.
Public Function SheetToHTML(sh As Worksheet)

Dim TempFile As String
Dim fso As Object
Dim ts As Object
'Debug.Print sh
sh.Copy
TempFile = sh.Parent.Path & "\TempHtml.htm"

With ActiveWorkbook.PublishObjects.Add(xlSourceRange, _
TempFile, "Аттестация", "A1:C22", xlHtmlStatic, "333_8568", "")
.Publish (True)
.AutoRepublish = False
End With

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
ActiveWorkbook.Close False
SheetToHTML = ts.ReadAll
ts.Close

Set ts = Nothing
Set fso = Nothing
Kill TempFile
End Function
'Декларация функции поиска запущенных процессов
Declare Function FindWindowByClass Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As Long) As Long

Все программы прекрасно отрабатывают но только один раз
при повторном запуске функция затыкается
Ручное закрытие Excel и остановка программ может приводить к восстановлению работы на один разю

~Vladimir~,
Сам перемудрил проблема решена
нельзя открывать Excel в процедуре Private Sub Отправить_Email()
Необходимо в основной задаче открыть файл Excel затем выполнять процедуру Private Sub Отправить_Email()
изменить строку .HTMLBody = SheetToHTML( ActiveWorkbook .Worksheets("Лист1"))