excel - excel vba发送带有嵌入图像的电子邮件
问题描述
我使用下面的宏创建带有嵌入图片的电子邮件,但它不起作用,因为我一直在接收
运行时错误 5“无效的过程调用或参数”
并突出显示此代码.BodyFormat = olFormatHTML
。
Sub Outlook_Email_With_Inline_Image()
'Add reference to Microsoft Outlook Object Library
Set aOutlook = CreateObject("Outlook.Application")
Set aEmail = aOutlook.CreateItem(0)
'Dim OutApp As Outlook.Application
'Dim oOutlookEmail As Outlook.MailItem
'Create New Outlook Email Item to Attach Image(s)
Set OutApp = CreateObject("Outlook.Application")
Set oOutlookEmail = OutApp.CreateItem(0)
'Actual Excel VBA to send email with Embedded images
With oOutlookEmail
.To = "user@gmail.com"
.CC = ""
.BCC = ""
.Subject = "Congrats"
.BodyFormat = olFormatHTML
.Attachments.Add "C:\Users\Username\Pictures\Michael's Email Promotion\Angela.jpg", olByValue, 0
sImgName = "ImageFile.img"
.HTMLBody = "<img src='cid:" & sImgName & "'" & " ><br>" 'Mention only the image file name not its path
'Or Use this below line.
'.HTMLBody = "<img src='" & sImgName & "'" & " ><br>"
.Display
' .Send 'or just put .Display to check
End With
Set OutlookMail = Nothing
Set OutApp = Nothing
End Sub
解决方案
Sub email()
Dim aOutlook As Object
Dim aEmail As Object
Dim obj As Object
Dim olInsp As Object
Dim myDoc As Object
Dim oRng As Object
Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"
Set oApp = CreateObject("Outlook.Application")
Set oEmail = oApp.CreateItem(olMailItem)
Dim ToCc As Range, strBody, strSig As String
Dim fColorBlue, fColorGreen, fColorRed, fDukeBlue1, fDukeBlue2, fAggieMaroon, fAggieGray As String
Dim Greeting, emailContent As String
Dim emailOpen, emailSig As String
For Each ToCc In ActiveSheet.[A2:A2]
'=============================================================
Dim ToEmail, CcEmail, ToNm, CcNm As String
Dim DescrDt, DescrID, DescrNm As String
ToNm = Cells(ToCc.Row, [C1].Column).Value
CcNm = Cells(ToCc.Row, [G1].Column).Value
ToEmail = Cells(ToCc.Row, [E1].Column).Value
CcEmail = Cells(ToCc.Row, [I1].Column).Value
DescrID = Cells(ToCc.Row, [B1].Column).Value
DescrNm = Cells(ToCc.Row, [D1].Column).Value
DescrDt = "20190426"
'=============================================================
'''determine strBody --email message
Dim strFontSize, strFontName, strFontColor As String
strFontName = "Arial"
strFontColor = fAggieGray
strFontSize = 13
Greeting = "<BODY style=" & Chr(34) & "font-family:" & strFontName & "; font-size:" & strFontSize & Chr(34) & ">" & _
"<span style=""color:" & strFontColor & """>" & _
Application.WorksheetFunction.Proper(ToNm) & "," & "<br> <br>" & _
"</span style=""color:" & strFontColor & """>" & "</BODY>"
emailSig = "<BODY style=" & Chr(34) & "font-family:" & strFontName & "; font-size:" & strFontSize & Chr(34) & ">" & _
"<span style=""color:" & strFontColor & """>" & _
"<br> <br>" & "- OE & HRIS Team" & "<br>" & "______________________" & "<br> <br>" & _
"</span style=""color:" & strFontColor & """>" & "</BODY>" & _
"<BODY style=" & Chr(34) & "font-family:" & strFontName & "; font-size: 10px;"">" & _
"<span style=""color:" & strFontColor & """>" & _
"[Email generated through Excel Macros and Google meme download - source data: October 3, 2019]" & _
"</span style=""color:" & strFontColor & """>" & "</BODY>"
Set colAttach = oEmail.Attachments
Set oAttach1 = colAttach.Add("C:\Users\AA.jpg")
Set oAttach2 = colAttach.Add("C:\Users\BB.png")
Set oAttach3 = colAttach.Add("C:\Users\CC.jpg")
Set oAttach4 = colAttach.Add("C:\Users\DD.gif")
Set oAttach5 = colAttach.Add("C:\Users\EE.png")
Set oAttach6 = colAttach.Add("C:\Users\FF.jpg")
Set oAttach7 = colAttach.Add("C:\Users\GG.jpg")
Set olkPA1 = oAttach1.PropertyAccessor
Set olkPA2 = oAttach2.PropertyAccessor
Set olkPA3 = oAttach3.PropertyAccessor
Set olkPA4 = oAttach4.PropertyAccessor
Set olkPA5 = oAttach5.PropertyAccessor
Set olkPA6 = oAttach6.PropertyAccessor
Set olkPA7 = oAttach7.PropertyAccessor
olkPA1.SetProperty PR_ATTACH_CONTENT_ID, "AA.jpg"
olkPA2.SetProperty PR_ATTACH_CONTENT_ID, "BB.png"
olkPA3.SetProperty PR_ATTACH_CONTENT_ID, "CC.jpg"
olkPA4.SetProperty PR_ATTACH_CONTENT_ID, "DD.gif"
olkPA5.SetProperty PR_ATTACH_CONTENT_ID, "EE.png"
olkPA6.SetProperty PR_ATTACH_CONTENT_ID, "FF.jpg"
olkPA7.SetProperty PR_ATTACH_CONTENT_ID, "GG.jpg"
oEmail.Close olSave
oEmail.HTMLBody = Greeting & "<BODY style=" & Chr(34) & "font-family:" & strFontName & "; font-size:" & strFontSize & Chr(34) & ">" & _
"<span style=""color:" & strFontColor & """>" & _
"<br> <br>" & _
"<img src=""cid:FF.jpg""height=520 width=750>" & _
"<br> <br>" & "<img src=""cid:AA.jpg""height=520 width=750>" & _
"<br> <br>" & "<img src=""cid:BB.png""height=520 width=750>" & _
"<br> <br>" & "<img src=""cid:DD.gif""height=520 width=750>" & _
"<br> <br>" & "<img src=""cid:GG.jpg""height=520 width=750>" & _
"<br> <br>" & "<img src=""cid:EE.png""height=520 width=750>" & _
"</body>"
oEmail.Save
oEmail.To = "MM@email.com"
oEmail.CC = "AA@email.com"
oEmail.Subject = "Congrats " & Application.WorksheetFunction.Proper(ToNm) & Chr(32) & Application.WorksheetFunction.Proper(DescrNm)
oEmail.display
'oEmail.send
NEXT_ToCC:
Set aEmail = Nothing
Set olInsp = Nothing
Set myDoc = Nothing
Set oRng = Nothing
Next ToCc
'oEmail.Send
Set oEmail = Nothing
Set colAttach = Nothing
Set oAttach = Nothing
Set oApp = Nothing
End Sub
推荐阅读
- angular - Angular 2+ textarea 占位符条件和翻译
- java - JComboBox 将与泛型类型数组列表一起使用吗?
- c# - 代理服务器 vs 主机文件 vs 防火墙,哪个以编程方式阻止 C# 中的网站?
- ios - UITableViewCell 只有在某个区域被按下时才会被选中
- pentaho - PDI 中“生成行”步骤中的变量
- angular - 角,量角器,黄瓜问题
- mysql - 在我的 sql 中加入两个表不返回结果集
- powershell - Powershell:通过将脚本指向功能列表来添加 WindowsFeature
- java - Firebase Auth:来自不同活动的getCurrentUser?
- c++ - 函数未返回所需的字符串