excel - 在 Outlook 中粘贴 Excel 范围

Question

我正在尝试使用 VBA 将选定范围从 Excel 粘贴到 Outlook。我想将其保留在与所有收件人的同一对话中。

我看到了一些代码:Outlook Reply or ReplyAll to an Email

我被这段代码困住了(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

Answer 1

编辑:
我注意到您的问题已被另一位用户编辑，现在您需要将电子邮件作为回复所有电子邮件的提及已消失。这可能是为了让你的问题更简单，但现在我的回答没有多大意义。我的回答还假设您已经拥有插入电子邮件所需的 HTML 代码。如果不是这种情况，您可能想看看 this gist帮助您开始将范围转换为 HTML 代码。

<小时/> question您链接到的是 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

<小时/>

关于将范围粘贴为图片

如果您采用上面代码中的方法，您将无法使用复制粘贴方法插入图像。我个人更喜欢设置电子邮件的 HTML 正文，因为它可以让您更好地控制。如果您同意使用 HTML 方法，您可以:

1. 将您的范围转换为 HTML 代码并将其插入电子邮件中(与上面代码中的操作方式类似)；或

2. 将您的范围转换为图像，保存并将其与 HTML 一起插入电子邮件正文中。

为了实现第二个选项，您可以运行以下代码:

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 过程从我们提供的范围生成图像文件。目前，该文件将始终以相同的名称保存在临时目录中，这意味着该文件将被覆盖。如果您要保留这些图像文件的副本，请随意更改名称或在名称中添加日期。