Вставить в Outlook диапазон Excel - PullRequest
2 голосов
/ 17 октября 2019

Я пытаюсь использовать VBA для вставки выбранного диапазона из Excel в Outlook. Я хочу держать его в одном разговоре со всеми получателями.

Я видел несколько кодов: Outlook Outlook или ReplyAll на электронную почту

Я застрял с этимкод (Application.ActiveExplorer.Selection).

Есть идеи, как это сделать?

Это код, который я имею при создании нового письма вместо ответа:

Sub a()
Dim r As Range
Set r = Range("B1:AC42")
r.Copy

'Paste as picture in sheet and cut immediately
Dim p As Picture
Set p = ActiveSheet.Pictures.Paste
p.Cut



'Open a new mail item
Dim outlookApp As Outlook.Application
Set outlookApp = CreateObject("Outlook.Application")
Dim outMail As Outlook.MailItem
Set outMail = outlookApp.CreateItem(olMailItem)

'Get its Word editor
outMail.Display
Dim wordDoc As Word.Document
Set wordDoc = outMail.GetInspector.WordEditor

With outMail
.BodyFormat = olFormatHTML
  .Display
  '.HTMLBody = "write your email here" & "<br>" & .HTMLBody
  .Subject = ""
  .Attachments.Add ("path")


End With
'Paste picture
wordDoc.Range.Paste

For Each shp In wordDoc.InlineShapes
shp.ScaleHeight = 50 shp.ScaleWidth = 50
 Next

End Sub

Ответы [ 2 ]

1 голос
/ 17 октября 2019

Вместо создания почтового элемента, Работа с Выбор Элемент

Пример outlookApp.ActiveExplorer.Selection (1)


Ваш код

Dim outMail As Outlook.MailItem
Set outMail = outlookApp.CreateItem(olMailItem)

'Get its Word editor
outMail.Display

Изменить на

Dim sel_Item As Outlook.MailItem
Set sel_Item = outlookApp.ActiveExplorer.Selection(1)    

Dim outMail As Outlook.MailItem
'Get its Word editor
Set outMail = sel_Item.ReplyAll
1 голос
/ 17 октября 2019

РЕДАКТИРОВАТЬ:
Я заметил, что ваш вопрос был отредактирован другим пользователем, и теперь упоминание о вашей необходимости, чтобы электронное письмо было ответным - все электронное письмо пропало. Вероятно, это было для того, чтобы сделать ваш вопрос проще, но теперь мой ответ не будет иметь особого смысла. Мой ответ также предполагает, что у вас уже есть HTML-код, необходимый для вставки электронного письма. Если это не так, возможно, вы захотите взглянуть на эту суть , чтобы начать преобразование диапазона в HTML-код.


Вопрос , на который вы ссылаетесь, был в Outlook VBA, поэтому вам нужно убедиться, что вы объявляете переменные иначе, поскольку в Excel VBA Application будет ссылаться на приложение Excel, а не на Outlook.

Вот как можно это сделать:

Sub ReplyAllWithTable()
    Dim outlookApp As Outlook.Application
    Set outlookApp = CreateObject("Outlook.Application")
    Dim olItem As Outlook.MailItem
    Dim olReply As MailItem ' ReplyAll

    Dim HtmlTable As String
    HtmlTable = "<table><tr><td>Test</td><td>123</td></tr><tr><td>123</td><td>test</td></tr></table>"

    For Each olItem In outlookApp.ActiveExplorer.Selection
    Set olReply = olItem.ReplyAll
    olReply.HTMLBody = "Here is the table: " & vbCrLf & HtmlTable & vbCrLf & olReply.HTMLBody
    olReply.Display

    'Uncomment next line when you're done with debugging
    'olReply.Send

    Next olItem
End Sub

О вставке диапазона в виде рисунка

Если вы воспользуетесь подходом в приведенном выше коде, вы выиграете 'Вы не сможете использовать метод copy-paste для вставки вашего изображения. Лично я предпочитаю задавать HTML-текст письма, поскольку он дает вам больше контроля. Если вы согласны с использованием метода HTML, вы можете:

  1. преобразовать свой диапазон в код HTML и вставить его в электронное письмо (аналогично тому, как это было сделано в коде выше);или

  2. конвертируйте свой диапазон в изображение, сохраните его и вставьте в текст письма с HTML.

Для достижения 2-гоопцию, вы можете запустить следующий код:

Sub ReplyAllWithTableAsPicture()

    'REFERENCE:
    '- https://excel-macro.tutorialhorizon.com/excel-vba-send-mail-with-embedded-image-in-message-body-from-ms-outlook-using-excel/

    Dim outlookApp As Outlook.Application
    Set outlookApp = CreateObject("Outlook.Application")
    Dim olItem As Outlook.MailItem
    Dim olReply As MailItem ' ReplyAll


    Dim fileName As String
    Dim fileFullName As String
    fileFullName = Environ("temp") & "\Temp.jpg" 'CUSTOMIZABLE (make sure this file can be overwritten at will)
    fileName = Split(fileFullName, "\")(UBound(Split(fileFullName, "\")))

    RangeToImage fileFullName:=fileFullName, rng:=ActiveSheet.Range("B1:AC42") 'CUSTOMIZABLE (choose the range to save as picture)

    For Each olItem In outlookApp.ActiveExplorer.Selection 'if we have only one email, we could use: set olItem = outlookApp.ActiveExplorer.Selection(1)
    Set olReply = olItem.ReplyAll
    olReply.Attachments.Add fileFullName, olByValue, 0
    olReply.HTMLBody = "Here is the table: " & "<br>" & "<img src='cid:" & fileName & "'>" & vbCrLf & olReply.HTMLBody
    olReply.Display

    'Uncomment this line when you're done with debugging
    'olReply.Send

    Next olItem
End Sub

и добавить в модуль также следующую подпроцедуру:

Sub RangeToImage(ByVal fileFullName As String, ByRef rng As Range)

    'REFERENCE:
    '- https://analystcave.com/excel-image-vba-save-range-workbook-image/

    Dim tmpChart As Chart, n As Long, shCount As Long, sht As Worksheet, sh As Shape
    Dim pic As Variant

    'Create temporary chart as canvas
    Set sht = rng.Worksheet
    rng.Copy
    sht.Pictures.Paste.Select
    Set sh = sht.Shapes(sht.Shapes.Count)
    Set tmpChart = Charts.Add
    tmpChart.ChartArea.Clear
    tmpChart.Name = "PicChart" & (Rnd() * 10000)
    Set tmpChart = tmpChart.Location(Where:=xlLocationAsObject, Name:=sht.Name)
    tmpChart.ChartArea.Width = sh.Width
    tmpChart.ChartArea.Height = sh.Height
    tmpChart.Parent.Border.LineStyle = 0

    'Paste range as image to chart
    sh.Copy
    tmpChart.ChartArea.Select
    tmpChart.Paste

    'Save chart image to file
    tmpChart.Export fileName:=fileFullName, FilterName:="jpg"

    'Clean up
    sht.Cells(1, 1).Activate
    sht.ChartObjects(sht.ChartObjects.Count).Delete
    sh.Delete

End Sub

Пояснения:

В процедуре ReplyAllWithTableAsPicture мы, по сути, делаем то же самое, что и первый код, но теперь мы прикрепляем изображение к электронному письму, но оставляем его «скрытым», чтобы мы могли просто включить его в телоэлектронной почты, не будучи в списке приложений, когда люди получают электронную почту. Чтобы включить изображение, мы используем тег img с источником, начинающимся с «cid», что позволяет нам ссылаться на «скрытое» вложение.

Поскольку изображение должно быть файлом, мы используем процедуру RangeToImage для генерации файла изображения из предоставленного нами диапазона. В настоящее время файл будет сохранен во временном каталоге всегда с тем же именем, что означает, что файл будет перезаписан. Вы можете сменить имя или добавить дату к имени, если хотите сохранить копии этих файлов изображений.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...