Хитрости »
Основные понятия (23)
Сводные таблицы и анализ данных (9)
Графики и диаграммы (5)
Работа с VB проектом (12)
Power BI и Power Query (14)
Условное форматирование (5)
Списки и диапазоны (5)
Макросы(VBA процедуры) (63)
Разное (38)
Баги и глюки Excel (2)

Вставить в письмо Outlook таблицу Excel с форматированием

Про создание писем в Outlook через Visual Basic for Applications(VBA) Excel я уже писал пару статей, в том числе и о том, как вставить одну из стандартных подписей в письмо - Вставить в письмо подпись из Outlook через VBA(по умолчанию при создании писем из VBA подпись не вставляется, даже если это настроено параметрами почты). Но т.к. отправка происходит из Excel, то часто возникает и другой вопрос - как в письмо вставить не просто текст, а целую таблицу? Да еще со всем форматированием ячеек? Если речь о ручной вставке, то тут все просто: скопировали диапазон, перешли в письмо - вставили. Но если попробовать тоже самое кодом (через копировать-вставить) - ничего не получится(у Outlook просто нет метода Paste или что-то вроде того). Можно использовать метод SendKeys, но он весьма нестабилен и я стараюсь его вообще нигде не применять, только в случаях, когда по-другому ну вообще никак. Если же переносить таблицу кодом вроде такого:
.Body = Range("A1").Value & Range("A2").Value
то это будут только значения ячеек, но не их форматирование и уж никак не таблица.
Все дело в том, что таблица в теле письма это отдельный объект формата HTML. И при вставке через копировать-вставить руками Excel и Outlook делают за нас всю грязную работу по перекодировке скопированного в нужный формат HTML. А значит и нам надо каким-то образом конвертировать нужные ячейки в этот формат, да еще учесть всё форматирование. К примеру, есть такая таблица:

Пример таблица для вставки в письмо Outlook

рис.1


Теперь эту таблицу надо вставить в письмо вместе с остальным текстом, чтобы было что-то вроде:
Письмо с форматированной таблицей

рис.2


Чтобы конвертировать нужные ячейки в самостоятельную таблицу в формате HTML я использую такую функцию:

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

Все, что остается - это в нужный момент вызвать эту функцию и вставить в нужное место письма.
Например, для конвертации в текст HTML выделенного на листе диапазона необходимо выполнить код:

Dim sTblBody As String
sTblBody = ConvertRngToHTM(Selection)

Чтобы создать письмо в Outlook и вставить туда эту таблицу можно использовать такой код:

Sub Send_Mail()
    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 = "адрес получателя"
        .Subject = "Тема: тест вставки таблицы"
        .BodyFormat = 2  'olFormatHTML - формат HTML
        .HTMLBody = ConvertRngToHTM(Selection)
        .Display 'отображаем сообщение
    End With
 
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub

Более подробно про создание и отправку писем из Excel я писал в этой статье: Как отправить письмо из Excel?
По сути основная задача выполнена, теперь вы сможете вкладывать в сообщение таблицу без потери форматирования.


Скачать файл:

  Пример вставки таблицы в письмо Outlook.xls (67,5 KiB, 926 скачиваний)


В файле-примере, приложенном к статье, более расширенный вариант кода, который оформлен более удобно, там можно задать в ячейках адрес получателя, тему письма и текст письма. Плюс помимо описанного выше добавляет форматирование к письму, проставляет корректные переносы и непосредственно вставляет таблицу в любое место письма.
За форматирование(назначает шрифт Arial, размер 14) отвечает строка:

sBody = "<span style=""font-size: 14px; font-family: Arial"">" & sBody & "</span>"

Полагаю, несложно догадаться где изменить размер шрифта и его имя. Так же можно и иное форматирование применять, если Вам знакомы основы работы с HTML.
Корректные для HTML переносы строк текста

'Переносы строк и шрифт
sBody = Replace(sBody, Chr(10), "<br />")
sBody = Replace(sBody, vbNewLine, "<br />")

Про вставку таблицы следует расписать чуть подробнее. В примере в ячейку B13 записан следующий текст:
Уважаемый клиент!
Только для Вас мы подготовили специальное предложение по товарам, которыми Вы интересовались в нашем Интернет-магазине:
{TABLE}
Будем рады видеть Вас среди наших постоянных клиентов!
(а для постоянных клиентов у нас действуют еще более выгодные условия)
С уважением, Дмитрий
менеджер по работе с постоянными клиентами

красным специально выделен тег {TABLE}. Именно на место этого тега будет вставлена таблица, созданная из указанного диапазона и результат будет как на рис.2(см.выше). Эту метку можно вставлять в любое место и именно туда будет помещена таблица.
В коде диапазон вставляемой таблицы указывается в строке:

Set rDataR = .Range("A15:D18") 'Selection - если надо отправить только выделенные диапазона

Его можно изменить на любой необходимый.
Что важно помнить: если помимо вставки таблицы Вы планируете форматировать письмо другими тегами HTML, то лучше сначала сделать все форматирование и только в самом конце, самым последним шагом, добавлять таблицу в письмо. Иначе разметка таблицы может "поплыть".

Надеюсь теперь Вам не составит труда сделать свои сообщения более красивыми и аккуратными.

Понимаю, что многие захотят сделать из этого массовую рассылку. Для этого придется совместить код из этой статьи с кодом из статьи Как отправить письмо из Excel?. Там есть пример отправки писем через Outlook списку получателей.


Подумал, что неплохо было бы дополнить статью простенькой функцией, которая не сохраняет никаких файлов, форматированных таблиц и практически не делает лишних движений. Она просто в письмо вкладывает значения всех ячеек указанного диапазона простым текстом, без форматирования(разве что добавил переносы строки и табуляцию, чтобы соблюдался хоть какой-то табличный вид и текст не был одной единой строкой):

'---------------------------------------------------------------------------------------
' Author : The_Prist(Щербаков Дмитрий)
'          Профессиональная разработка приложений для MS Office любой сложности
'          Проведение тренингов по MS Excel
'          http://www.excel-vba.ru
' Purpose: функция объединяет значения указанного диапазона ячеек в строку
'          разрывы между столбцами заменяются табуляцией
'          разрывы между строками заменяются переносами на строки
'---------------------------------------------------------------------------------------
Function RangeToTextTable(rng As Range)
    Dim lr As Long, lc As Long, arr
    Dim res As String
 
    arr = rng.Value
    If Not IsArray(arr) Then
        ReDim arr(1 To 1, 1 To 1)
        arr(1, 1) = rng.Value
    End If
    For lr = 1 To UBound(arr, 1)
        For lc = 1 To UBound(arr, 2)
            If lc = 1 Then
                res = res & arr(lr, lc)
            Else
                res = res & vbTab & arr(lr, lc)
            End If
        Next
        res = res & vbNewLine
    Next
    RangeToTextTable = res
End Function

Вставляем значения ячеек при помощи этой функции в письмо:

    'создаем сообщение
    With objMail
        .To = "адрес получателя"
        .Subject = "Тема: тест вставки таблицы"
        '.BodyFormat = 2  'уже не надо, т.к. форматирования нет
        .HTMLBody = RangeToTextTable(Selection)
        .Display 'отображаем сообщение
    End With

Здесь следует помнить, что "таблица" после такой вставки будет выглядеть не очень красиво. И речь не о цвете заголовков - при различной длине текста внутри ячеек текст в письме будет сдвигаться:
Письмо без форматирования
чтобы этого как-то избежать, можно чуть модифицировать функцию:

'---------------------------------------------------------------------------------------
' Author : The_Prist(Щербаков Дмитрий)
'          Профессиональная разработка приложений для MS Office любой сложности
'          Проведение тренингов по MS Excel
'          http://www.excel-vba.ru
'          WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
' Purpose: функция объединяет значения указанного диапазона ячеек в строку
'          разрывы между столбцами заменяются табуляцией
'          разрывы между строками заменяются переносами на строки
'---------------------------------------------------------------------------------------
Function RangeToTextTable(rng As Range)
    Dim lr As Long, lc As Long, arr
    Dim res As String, rh()
    Dim lSpaces As Long, s As String
 
    arr = rng.Value
    If Not IsArray(arr) Then
        ReDim arr(1 To 1, 1 To 1)
        arr(1, 1) = rng.Value
    End If
    ReDim rh(1 To UBound(arr, 2))
    For lr = 1 To UBound(arr, 1)
        For lc = 1 To UBound(arr, 2)
            If Len(arr(lr, lc)) > rh(lc) Then
                rh(lc) = Len(arr(lr, lc))
            End If
        Next
    Next
    For lr = 1 To UBound(arr, 1)
        For lc = 1 To UBound(arr, 2)
            s = arr(lr, lc)
            lSpaces = rh(lc) - Len(s)
            If lSpaces > 0 Then
                s = s & Space(lSpaces)
            End If
            If lc = 1 Then
                res = res & s
            Else
                res = res & vbTab & s
            End If
        Next
        res = res & vbNewLine
    Next
    RangeToTextTable = res
End Function

и назначить шрифт для писем по умолчанию Courier New или любой другой мноноширный шрифт. Тогда можно получить примерно такой результат:
Таблица в письме без форматирования моноширным шрифтом
Если использовать не моноширный шрифт, то визуально таблица все равно будет неравной и смысла в модификации функции нет.

Так же см.:
Как отправить письмо из Excel?
Вставить в письмо подпись из Outlook через VBA
Сохранить вложения из Outlook в указанную папку


Статья помогла? Поделись ссылкой с друзьями!
  Плейлист   Видеоуроки

Поиск по меткам

Access apple watch Multex Outlook Power Query и Power BI VBA работа в редакторе VBA управление кодами Бесплатные надстройки Дата и время Диаграммы и графики Записки Защита данных Интернет Картинки и объекты Листы и книги Макросы и VBA Надстройки Настройка Печать Поиск данных Политика Конфиденциальности Почта Программы Работа с приложениями Работа с файлами Разработка приложений Сводные таблицы Списки Тренинги и вебинары Финансовые Форматирование Формулы и функции Функции Excel Функции VBA Ячейки и диапазоны акции MulTEx анализ данных баги и глюки в Excel ссылки
Обсуждение: 2 комментария
  1. Дмитрий:

    Огромное спасибо! Все очень доступно расписано и прекрасно работает. У меня возник только один вопрос. Как в таблице оставить гиперссылки? При преобразовании они удаляются(

    • romanss:

      Все работает, только текст, который вне таблицы читается хорошо, а вот сама таблица вставляется в виде иероглифов. С чем это может быть связано?

Поделитесь своим мнением

Комментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум


Для оформления сообщений Вы можете использовать следующие тэги:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Тренинги

Заказать
Юридическая информация

Использование материалов сайта

Политика Конфиденциальности

ИП Щербаков Дмитрий Валентинович
ОГРНИП: 318502700083307
ИНН: 504013350772

Наши партнеры

Перейти
Перейти

Счетчики

Рейтинг@Mail.ru Яндекс.Метрика
© 2018 Excel для всех   Войти