2013-03-13 114 views
0

我試圖從Excel工作表添加圖像到Outlook電子郵件。使用Excel VBA將圖像添加到Outlook HTML正文

我已經嘗試使用存儲在網絡位置和Internet上的圖像的鏈接。但是,並非所有用戶都可以訪問這些解決方案。

是否有可能將圖像存儲在另一個工作表中,然後將其複製到電子郵件正文中?

我知道下面將無法正常工作,因爲你不能導出形狀,但我可以這樣做嗎?

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

回答

0

一般電子郵件圖像Web服務器存儲,與SRC指向該服務器(http://...)。它們並不嵌入電子郵件本身。

+0

好的謝謝你,但它不會最後回答我如何將excel中的圖像放入電子郵件中。 – evoandy 2013-03-13 14:28:29

+0

您可以將其作爲附件進行操作。請參閱:http://stackoverflow.com/questions/6224766/how-to-add-an-embedded-image-to-an-html-message-in-outlook-2010 – 2013-03-13 14:30:31

+1

我可以附加他們,但理想情況下,我希望他們內電子郵件正文 – evoandy 2013-03-13 15:07:05

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

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 

清理: 集OutApp =無 Application.ScreenUpdating =真 結束子

公用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 '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 

結束子