使用Excel VBA将图像从Excel工作表添加到Outlook HTML正文

Question

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. 我尝试使用指向存储在网络位置和Internet上的图像的链接。 However, not all users will have access to these locations. 但是，并非所有用户都可以访问这些位置。

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

Answer 1

The CreateEmail Sub calls the SaveToImage Sub. CreateEmail子调用SaveToImage子。 The SaveToImage sub grabs a range, creates a chart on a new page and then saves the picture(objChart) to a specified directory. 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

Answer 2

In general email images are stored on a web server , with the SRC pointing to that server ( http://... ). 通常，电子邮件图像存储在Web服务器上 ，而SRC指向该服务器（ http://... ）。 They're not embedded in the email itself. 它们没有嵌入电子邮件本身。

使用Excel VBA将图像从Excel工作表添加到Outlook HTML正文

问题描述

2 个解决方案

解决方案1
1 2015-05-29 18:51:05

解决方案2
0 2013-03-13 14:25:17

使用Excel VBA将图像从Excel工作表添加到Outlook HTML正文

问题描述

2 个解决方案

解决方案1 1 2015-05-29 18:51:05

解决方案2 0 2013-03-13 14:25:17

解决方案1
1 2015-05-29 18:51:05

解决方案2
0 2013-03-13 14:25:17