使用Excel VBA将图像添加到Outlook HTML正文 [英] Add image to Outlook HTML body using Excel VBA

问题描述

我已经尝试使用存储在网络位置中的图像的链接，并尝试将图片从Excel工作表添加到Outlook电子邮件中。在网上。但是，并非所有用户都可以访问这些解决方案。

是否可以将图像存储在另一个工作表中，然后将其复制到电子邮件正文中？

我知道下面的行不通，因为你不能导出形状，但我可以做这样的事吗？

<$ p $ > code> ActiveUser = Environ $（UserName）
TempFilePath =C：\ Users \& ActiveUser& \Desktop\

表格（图像）。形状（PanelComparison）。导出TempFilePath& \PanelComparison.png
panelimage =< img src =TempFilePath \PanelComparison.pngwidth = 1000 height = 720 border = 0>

解决方案

CreateEmail Sub调用SaveToImage Sub。 SaveToImage子抓取一个范围，在新页面上创建一个图表，然后将图片（objChart）保存到指定的目录中。

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）
 
调用SaveToImage 
 
 
 ws.Activate 
 
 LMpic = wb.Path& \ClarityEmailPic.jpg'
 
 On Error GoTo清理
对于列中的每个单元格（D）Cells.SpecialCells（xlCellTypeConstants）
如果cell.Value赞?*@?*.?*然后
 
 FN = Cells（cell.Row，B）。Value 
 LN = Cells（cell.Row，A）。值
 EmBody =范围（Email_Body）。值
 EmBody1 =范围（Email_Body1）。值
 EmBody2 =范围（Email_Body2）值
'EmBody3 =范围（Email_Body3）。价值
 
 Set OutMail = OutApp.CreateItem（0）
错误恢复下一个
带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>亲爱的& FN& & LN& ，& < / P> 中&安培; _ 
< p> &安培; EmBody& < / P> 中&安培; _ 
< p> &安培; EmBody2& < i>< font color = red> &安培; EmBody1& < / I>< /字体> 中&安培; < / 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 
 $ b $ Public Sub SaveToImage（）
'
'SaveToImage宏
'
 
 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'定位&分配当前文件夹路径
 picname =ClarityEmailPic.jpg'图像文件名称
 
 Application.ScreenUpdating = False 
 
调用ws.Range（Picture）。 CopyPicture（xlScreen，xlPicture）'将范围复制为图像
 
 Worksheets.Add（after：= Worksheets（1））。Name =Sheet4'创建一个插入图表的新工作表
 ActiveSheet.Shapes.AddChart.Select 
 Set objChart = ActiveChart 
 ActiveSheet.Shapes.Item（1）.Width = ws.Range（Picture）。Width'make chart size match image range range size 
 HeightSheet.Shapes.Item（1）.Height = ws.Range（Picture）。Height 
 $ b objChart.Paste'将范围粘贴到图表
 objChart.Export （folderpath& picname）'使用活动图创建图像文件
 
 Application.DisplayAlerts = False 
 ActiveWindow.SelectedSheets.Delete'删除sheet4 
 Application.DisplayAlerts = True 
 
 
 
结束Sub 
  

I am trying to add an image from an Excel sheet to an Outlook email.

I have already 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 solutions.

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>"

解决方案

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.

The LMpic string variable calls the image just saved and inputs it into the HTML body.

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

这篇关于使用Excel VBA将图像添加到Outlook HTML正文的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！