我通过excel发送的电子邮件不会在接收端显示嵌入的图像。然而,嵌入的图像确实显示在我的最后。我的猜测是路径与我的桌面相关联。
如何显示图像?无法搞清楚问题。我的代码如下:
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`
答案 0 :(得分:2)
试试这段代码。从一些网站长时间拍摄,但仍然像魅力一样工作 想法是以隐藏的方式附加图像,然后将其添加到使用HtmlBody中的图像名称。
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~
的更新强>
我添加了另一个函数来检索图像的宽度和高度。我还更新了现有的sub以合并图像大小。
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
答案 1 :(得分:0)
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