我正在尝试使用VBA将选定范围从Excel粘贴到Outlook。我希望与所有收件人进行相同的对话。
我已经看到一些代码:Outlook Reply或Email的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
编辑:
我注意到您的问题是由另一个用户编辑的,现在您提到需要将电子邮件作为回信的电子邮件已经消失了。这可能是为了使您的问题更简单,但是现在我的答案没有太大意义了。我的回答还假设您还已经具有插入电子邮件所需的HTML代码。如果不是这种情况,您可能希望了解一下要点,以开始将范围转换为HTML代码。
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方法,则可以:
将您的范围转换为HTML代码并将其插入到电子邮件中(类似于上面代码中的操作);要么
将范围转换为图像,保存并在HTML邮件正文中插入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
过程从提供的范围中生成图像文件。当前,该文件将始终以相同的名称保存在临时目录中,这意味着该文件将被覆盖。如果要保留这些图像文件的副本,请随时更改名称或在名称中添加日期。
本文收集自互联网,转载请注明来源。
如有侵权,请联系[email protected] 删除。
我来说两句