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
結束子
好的謝謝你,但它不會最後回答我如何將excel中的圖像放入電子郵件中。 – evoandy 2013-03-13 14:28:29
您可以將其作爲附件進行操作。請參閱:http://stackoverflow.com/questions/6224766/how-to-add-an-embedded-image-to-an-html-message-in-outlook-2010 – 2013-03-13 14:30:31
我可以附加他們,但理想情況下,我希望他們內電子郵件正文 – evoandy 2013-03-13 15:07:05