Dim objOutlookApp As Object, objMail As Object

  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

  On Error GoTo 0

  'создаем сообщение

  With objMail

      .To = Range("B7").Value

      .Subject = "Добрый день!...."

      .BodyFormat = 2  'olFormatHTML - формат HTML

      .HTMLBody = ConvertRngToHTM(Range("A2:M6"))

      .Display 'отображаем сообщение

      .ReadReceiptRequested = True

      objMail.Importance = 2 'olImportanceHigh

  End With

  Set objOutlookApp = Nothing: Set objMail = Nothing

  Application.ScreenUpdating = True

End Sub

Function ConvertRngToHTM(rng As Range)

  Dim fso As Object, ts As Object

  Dim sF As String, resHTM As String

  Dim wbTmp As Workbook

  sF = Environ("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

  'переносим указанный диапазон в новую книгу

  rng.Copy

  Set wbTmp = Workbooks.Add(1)

  With wbTmp.Sheets(1)

      'вставляем только ширину столбцов, значения и форматы

      .Cells(1).PasteSpecial xlPasteColumnWidths

      .Cells(1).PasteSpecial xlPasteValues

      .Cells(1).PasteSpecial xlPasteFormats

      .Cells(1).Select

      Application.CutCopyMode = False

      'удаляем все объекты(фигуры, рисунки и пр.)

      '------------------------------------------

      'если рисунки и объекты нужны - удалить этот блок

      On Error Resume Next

      .DrawingObjects.Visible = True

      .DrawingObjects.Delete

      On Error GoTo 0

      '------------------------------------------

  End With

  'сохраняем книгу как Веб-страницу(чтобы содержимое конвертировать в HTML-код)

  With wbTmp.PublishObjects.Add( _

       SourceType:=xlSourceRange, Filename:=sF, _

       Sheet:=wbTmp.Sheets(1).Name, Source:=wbTmp.Sheets(1).UsedRange.Address, _

       HtmlType:=xlHtmlStatic)

      .Publish (True)

  End With

  'открываем созданный файл как текстовый и считываем содержимое

  Set fso = CreateObject("Scripting.FileSystemObject")

  Set ts = fso.GetFile(sF).OpenAsTextStream(1, -2)

  resHTM = ts.ReadAll

  ts.Close

  'выравниваем таблицу по левому краю(если надо оставить по центру - удалить эту строку)

  ConvertRngToHTM = Replace(resHTM, "align=center x:publishsource=", "align=left x:publishsource=")

  'закрываем временную книгу и удаляем

  wbTmp.Close False

  Kill sF

  'очищаем объектные переменные

  Set ts = Nothing: Set fso = Nothing

  Set wbTmp = Nothing

End Function