在使用 Excel VBA 发送的电子邮件中内联附加图像
Posted
技术标签:
【中文标题】在使用 Excel VBA 发送的电子邮件中内联附加图像【英文标题】：Attach an image inline in an email sent using Excel VBA 【发布时间】：2019-05-10 07:14:28 【问题描述】：我正在尝试从 Excel 发送多封电子邮件。
Set attPr = attachment.PropertyAccessor 行给出了错误
“对象不支持属性或方法”。
我尝试将附件声明为显式附件对象（您可以看到已被注释掉）。我得到了错误
“未定义用户定义类型”
从我构建的 html 正文 (htmlTemp) 中可以看出，我想要实现的是将图像添加为电子邮件正文的一部分。
Sub Send_Email_Using_VBA_InlineBMPs()
Dim wb As Workbook
Dim sh As Worksheet
Set wb = ThisWorkbook
Dim Email_Subject, Email_Send_From, Email_Send_To, Email_Cc, Email_Body, Email_Attach As String
Dim htmlTemp, body1, body2 As String
Dim Mail_Object, Mail_Single, attachment, attPr As Variant
'Dim attachment As Outlook.Attachments
'Dim oPA As Outlook.PropertyAccessor
For Each sh In wb.Worksheets
If sh.Name Like "Sheet 13*" Then
Email_Subject = "HTML TEST - " & sh.Range("C129").Value
Email_Send_From = "email@email.com"
Email_Send_To = "email@email.com"
Email_Cc = "email@email.com" ';
'Email_Body = sh.Range("C124").Value
Email_Attach = ThisWorkbook.Path & "\" & sh.Range("R3").Value & ".pdf"
Email_Picture = ThisWorkbook.Path & "\" & sh.Range("R3").Value & ".bmp"
On Error GoTo debugs
body1 = sh.Range("C124").Value
body2 = Replace(body1, Chr(10), "<br>") 'to add newline
Email_Body = body2
'htmlTemp = "<!DOCTYPE html><html><body>"
'htmlTemp = "<div id=email_body style='font-size: 12px; font-style: Arial'>"
htmlTemp = "<div id=email_body>"
htmlTemp = htmlTemp & Email_Body
htmlTemp = htmlTemp & "<br><img src='cid:" & sh.Range("R3").Value & "' style='max-width: 100%; height: auto;'><br>"
htmlTemp = htmlTemp & "</div>"
'htmlTemp = htmlTemp & "</body></html>"
Set Mail_Object = CreateObject("Outlook.Application")
Set Mail_Single = Mail_Object.CreateItem(0)
Set attachment = Mail_Single.Attachments '.Add(Email_Picture)
attachment.Add Email_Picture
Set attPr = attachment.PropertyAccessor
'attachment.PropertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x3712001F", sh.Range("R3").Value
With Mail_Single
.Subject = Email_Subject
.To = Email_Send_To
.CC = Email_Cc
'.body = htmlTemp
.HTMLBody = htmlTemp
'.Attachments.Add (Email_Attach)
'.Attachments.Add Email_Picture, olByValue, 0
.send
End With
debugs:
If Err.Description <> "" Then MsgBox Err.Description
End If
Next
End Sub
注意：图片已经存在于文件夹中。
这里是让我想到这一点的解决方案的链接。 link 1link 2
【问题讨论】：
这是你正在尝试的吗？ ***.com/a/44599739/4539709 【参考方案1】：要将图像直接添加到 HTML 电子邮件正文，您必须使用以下 HTML 代码：
<img src='image name + extension'>
您必须执行以下操作：
-
将您的图片附加到电子邮件中
将此代码添加到您的 HTML 正文中：
<img src='image name + extension'>
您可以添加一些参数，例如高度或宽度。
图片名称不能包含空格。
您可以在下面看到示例。
Sub Sent_email_with_img()
Dim my_email As MailItem
Set out_look_app = CreateObject("Outlook.Application")
Set my_email = out_look_app.CreateItem(my_item)
With my_email
.To = ""
.CC = ""
.Subject = ""
' here you have to attache img which you would see in email body
' attachment will be invisible
.Attachments.Add Source:="PATH TO IMAGE\IMAGE_NAME.png"
' you can edit width and height of img in email body
' I changed width to 400 and height to 250
.HTMLBody = "<p>This is my image</p>" _
& "<img src='FILE_NAME.png'" _
& "width=400 height=250>"
' display email
.Display
End With
End Sub
【讨论】：
我有类似的代码，当它到达 .display 时，图像工作正常，可以在移动设备上看到。如果我有 direct.send 它不能像在移动设备上那样工作，图像是空白的，根本不显示。有什么建议吗？ 您的附件变量指向附件（复数）集合，而不是附件对象（取消注释 .Add 部分）【参考方案2】：根据我的研究，我找到了这篇文章Use VBA to Change the Name of Specific Attachment when the Send Button it Hit并注意到了：
如果您使用 Attachment.PropertyAccessor.SetProperty 设置 PR_ATTACH_LONG_FILENAME，Outlook 将引发异常。您可以使用扩展 MAPI 来设置属性。
【讨论】：
以上是关于在使用 Excel VBA 发送的电子邮件中内联附加图像的主要内容，如果未能解决你的问题，请参考以下文章
使用Excel VBA发送带有图表对象的电子邮件 - Office 2013