通过excel发送embedded式图像的电子邮件
通过excel发送的电子邮件不会在接收端显示embedded的图像。 但是embedded的图像显示在我的最后。 我的猜测是path与我的桌面相关联。
我怎样才能让图像显示？ 无法找出修复。 我的代码如下：
Sub EmailDailyFlow() Dim mainWB As Workbook Set otlApp = CreateObject("Outlook.Application") Set olMail = otlApp.CreateItem(olMailItem) Set mainWB = ActiveWorkbook With olMail .To = "email@gmail.com" .Cc = "" .Subject = Format(Date - 1, "M.dd.yyyy") & " " & "MF & VIT Daily Fund Flow" .HTMLBody = "<html><body style='font-family: Times New Roman, Times, serif; font-size: 16px;'>" & _ "<p>Please see below.</p>" & _ "<p><u><b>Volatility:</u></b></p>" & _ "<img src='C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images\MF.png'>" & _ "<p><u><b>Muni:</u></b></p>" & _ "<img src='C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images\MUNI.png'>" & _ "<p><u><b>AFC:</u></b></p>" & _ "<img src='C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images\AFC.png'>" & _ "<p><u><b>AFT:</u></b></p>" & _ "<img src='C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images\AFT.png'>" & _ "<p><u><b>VIT:</u></b></p>" & _ "<img src='C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images\VIT.png'>" & _ "<p>Thank you,</p>" & _ "</body></html>" .Send End With MsgBox ("Daily flow emails sent!") End Sub` 试试这个代码。 从一些网站采取长期回来，但仍然像一个魅力工作。
想法是以隐藏的方式附加图像，然后将其添加到HtmlBody中使用图像名称。
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~
更新：
我已经添加了另一个函数来检索图像的宽度和高度。 我也更新了现有的子，以合并图像大小。
Sub EmailDailyFlow() Dim SendID Dim CCID Dim Subject Dim stdPic As StdPicture Dim imageSize As String Dim strPathImg1 As String Dim strFileImg1 As String Dim lngWidthImg1 As Long Dim lngHeightImg1 As Long Dim strPathImg2 As String Dim strFileImg2 As String Dim lngWidthImg2 As Long Dim lngHeightImg2 As Long Dim olMail As MailItem 'REQUIRES MICROSOFT OBJECT OUTLOOK LIBRARY REFERENCE strPathImg1 = "C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images" strFileImg1 = "MF.png" imageSize = GetImageSize(strPathImg1, strFileImg1) lngWidthImg1 = CLng(Split(imageSize, ":")(0)) lngHeightImg1 = CLng(Split(imageSize, ":")(1)) strPathImg2 = "C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images" strFileImg2 = "MUNI.png" imageSize = GetImageSize(strPathImg2, strFileImg2) lngWidthImg2 = CLng(Split(imageSize, ":")(0)) lngHeightImg2 = CLng(Split(imageSize, ":")(1)) Set otlApp = CreateObject("Outlook.Application") Set olMail = otlApp.CreateItem(olMailItem) SendID = "email@gmail.com" CCID = "" Subject = Format(Date - 1, "M.dd.yyyy") & " " & "MF & VIT Daily Fund Flow" With olMail .To = SendID If CCID <> "" Then .CC = CCID End If .Subject = Subject 'ADD THE IMAGE IN HIDDEN MANNER, POSITION AT 0 WILL MAKE IT HIDDEN .Attachments.Add strPathImg1 & "\" & strFileImg1, olByValue, 0 .Attachments.Add strPathImg2 & "\" & strFileImg2, olByValue, 0 'NOW ADD IT TO THE HTML BODY USING IMAGE NAME 'CHANGE THE SRC PROPERTY TO 'cid:your image filename' 'IT WILL BE CHANGED TO THE CORRECT CID WHEN ITS SENT. .HTMLBody = "<html><body style='font-family: Times New Roman, Times, serif; font-size: 16px;'>" & _ "<p>Please see below.</p>" & _ "<p><u><b>Volatility:</u></b></p>" & _ "<img src='cid:" & strFileImg1 & "' width='" & lngWidthImg1 & "' height='" & lngHeightImg1 & "'>" & _ "<p><u><b>Muni:</u></b></p>" & _ "<img src='cid:" & strFileImg2 & "' width='" & lngWidthImg2 & "' height='" & lngHeightImg2 & "'>" & _ "<p><u><b>AFC:</u></b></p>" & _ "<p>Thank you,</p>" & _ "</body></html>" '.Display 'UNCOMMENT ME IF YOU WANT TO DISPLAY THE EMAIL .Send End With MsgBox ("Daily flow emails sent!") End Sub Function GetImageSize(filePath As String, fileName As String) As String 'THIS WILL RETURN IMAGE SIZE IN "xyz:xyz" STRING FORMAT Dim strImageDimensions As String Dim objShell As Object Dim objFolder As Object Dim objFile As Object Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.Namespace((filePath)) Set objFile = objFolder.ParseName(fileName) strImageDimensions = objFile.ExtendedProperty("Dimensions") strImageDimensions = Replace(Mid(strImageDimensions, 2, Len(strImageDimensions) - 2), " x ", ":") GetImageSize = strImageDimensions Set objFile = Nothing: Set objFolder = Nothing: Set objShell = Nothing End Function
Sub EmailDailyFlow() Dim oApp As Outlook.Application Dim oEmail As MailItem Dim colAttach As Outlook.Attachments Dim oAttach1 As Outlook.Attachment Dim oAttach2 As Outlook.Attachment Dim oAttach3 As Outlook.Attachment Dim oAttach4 As Outlook.Attachment Dim oAttach5 As Outlook.Attachment Dim olkPA As Outlook.PropertyAccessor Const PR_ATTACH_CONTENT_ID="http://schemas.microsoft.com/mapi/proptag/0x3712001F"
Set oApp = CreateObject("Outlook.Application") Set oEmail = oApp.CreateItem(olMailItem) Set colAttach = oEmail.Attachments Set oAttach1 = colAttach.Add("C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images\MF.png") Set oAttach2 = colAttach.Add("C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images\Muni.png") Set oAttach3 = colAttach.Add("C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images\AFC.png") Set oAttach4 = colAttach.Add("C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images\AFT.png") Set oAttach5 = colAttach.Add("C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images\VIT.png") Set olkPA1 = oAttach1.PropertyAccessor Set olkPA2 = oAttach2.PropertyAccessor Set olkPA3 = oAttach3.PropertyAccessor Set olkPA4 = oAttach4.PropertyAccessor Set olkPA5 = oAttach5.PropertyAccessor olkPA1.SetProperty PR_ATTACH_CONTENT_ID, "MF.png" olkPA2.SetProperty PR_ATTACH_CONTENT_ID, "MUNI.png" olkPA3.SetProperty PR_ATTACH_CONTENT_ID, "AFC.png" olkPA4.SetProperty PR_ATTACH_CONTENT_ID, "AFT.png" olkPA5.SetProperty PR_ATTACH_CONTENT_ID, "VIT.png" oEmail.Close olSave oEmail.HTMLBody = "<body style='font-family: Times New Roman, Times, serif; font-size: 16px;'><p>Please see below.</p>" & _ "<img src='cid:MF.png'>" & _ "<p><u><b>Muni:</u></b></p>" & _ "<img src='cid:MUNI.png'>" & _ "<p><u><b>afcCore:</u></b></p>" & _ "<img src='cid:AFC.png'>" & _ "<p><u><b>aft:</u></b></p>" & _ "<img src='cid:AFT.png'>" & _ "<p><u><b>VIT:</u></b></p>" & _ "<img src='cid:VIT.png'>" & _ "<p>Thank you,</p>" & _ "</body>" oEmail.Save oEmail.To = "email@email.com" oEmail.CC = "" oEmail.Subject = Format(Date - 1, "M.dd.yyyy") & " " & "MF & VIT Daily Fund Flow" oEmail.Send Set oEmail = Nothing Set colAttach = Nothing Set oAttach = Nothing Set oApp = Nothing
End Sub