使用 Excel VBA 将 Excel 工作表中的图像添加到 Outlook HTML 正文
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/15387901/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Add image from Excel sheet to Outlook HTML body using Excel VBA
提问by evoandy
I am trying to add an image from an Excel sheet to an Outlook email.
我正在尝试将 Excel 工作表中的图像添加到 Outlook 电子邮件中。
I tried using a link to an image stored in a network location and on the Internet. However, not all users will have access to these locations.
我尝试使用指向存储在网络位置和 Internet 上的图像的链接。但是，并非所有用户都可以访问这些位置。
Is it possible to store the image in another worksheet and then copy it into the email body?
是否可以将图像存储在另一个工作表中，然后将其复制到电子邮件正文中？
I know the below won't work because you can't export shapes but can I do something like this?
我知道下面的方法不起作用，因为你不能导出形状，但我可以做这样的事情吗？
ActiveUser = Environ$("UserName")
TempFilePath = "C:\Users\" & ActiveUser & "\Desktop\"
Sheets("Images").Shapes("PanelComparison").Export TempFilePath & "\PanelComparison.png"
panelimage = "<img src = ""TempFilePath\PanelComparison.png"" width=1000 height=720 border=0>"
回答by James
The CreateEmail Sub calls the SaveToImage Sub. The SaveToImage sub grabs a range, creates a chart on a new page and then saves the picture(objChart) to a specified directory.
CreateEmail Sub 调用 SaveToImage Sub。SaveToImage 子抓取范围，在新页面上创建图表，然后将图片（objChart）保存到指定目录。
The LMpic string variable calls the image just saved and inputs it into the HTML body.
LMpic 字符串变量调用刚刚保存的图像并将其输入到 HTML 正文中。
Public Sub CreateEmail()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim FN, LN, EmBody, EmBody1, EmBody2, EmBody3 As String
Dim wb As Workbook
Dim ws As Worksheet
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set wb = ActiveWorkbook
Set ws = Worksheets("Sheet1")
Call SaveToImage
ws.Activate
LMpic = wb.Path & "\ClarityEmailPic.jpg'"
On Error GoTo cleanup
For Each cell In Columns("D").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" Then
FN = Cells(cell.Row, "B").Value
LN = Cells(cell.Row, "A").Value
EmBody = Range("Email_Body").Value
EmBody1 = Range("Email_Body1").Value
EmBody2 = Range("Email_Body2").Value
'EmBody3 = Range("Email_Body3").Value
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Volt Clarity Reminder "
.Importance = olImportanceHigh
.HTMLBody = "<html><br><br><br>" & _
"<table border width=300 align=center>" & _
"<tr bgcolor=#FFFFFF>" & _
"<td align=right>" & _
"<img src='" & objRange & "'>" & _
"</td>" & _
"</tr>" & _
"<tr border=0.5 height=7 bgcolor=#102561><td colspan=2></td></tr>" & _
"<tr>" & _
"<td colspan=2 bgcolor=#E6E6E6>" & _
"<body style=font-family:Arial style=backgroung-color:#FFFFFF align=center>" & _
"<p> Dear " & FN & " " & LN & "," & "</p>" & _
"<p>" & EmBody & "</p>" & _
"<p>" & EmBody2 & "<i><font color=red>" & EmBody1 & "</i></font>" & "</p>" & _
"</body></td></tr></table></html>"
.Display 'Or use Display
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Public Sub SaveToImage()
'
' SaveToImage Macro
'
Dim DataObj As Shape
Dim objChart As Chart
Dim folderpath As String
Dim picname As String
Dim ws As Worksheet
Application.ScreenUpdating = False
Set ws = Worksheets("Sheet2")
folderpath = Application.ActiveWorkbook.Path & Application.PathSeparator 'locating & assigning current folder path
picname = "ClarityEmailPic.jpg" 'image file name
Application.ScreenUpdating = False
Call ws.Range("Picture").CopyPicture(xlScreen, xlPicture) 'copying the range as an image
Worksheets.Add(after:=Worksheets(1)).Name = "Sheet4" 'creating a new sheet to insert the chart
ActiveSheet.Shapes.AddChart.Select
Set objChart = ActiveChart
ActiveSheet.Shapes.Item(1).Width = ws.Range("Picture").Width 'making chart size match image range size
ActiveSheet.Shapes.Item(1).Height = ws.Range("Picture").Height
objChart.Paste 'pasting the range to the chart
objChart.Export (folderpath & picname) 'creating an image file with the activechart
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete 'deleting sheet4
Application.DisplayAlerts = True
End Sub
回答by Diodeus - James MacFarlane
In general email images are stored on a web server, with the SRC pointing to that server (http://...). They're not embedded in the email itself.
通常，电子邮件图像存储在 Web 服务器上，SRC 指向该服务器 ( http://...)。它们没有嵌入电子邮件本身。
