我正在尝试编写一个宏,它将复制并粘贴范围到outlook中的电子邮件中。我有文本和格式,我想包括在粘贴在电子邮件中的范围以下。
Sub sendEmailwithPic()
Dim OutApp As Object
Dim OutMail As Object
Dim table As Range
Dim pic As Picture
Dim ws As Worksheet
Dim wordDoc
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'grab table, convert to image, and cut
Set ws = ThisWorkbook.Sheets("Sheet1")
Set table = ws.Range("A1:E11")
ws.Activate
table.Copy
Set pic = ws.Pictures.Paste
pic.Cut
'create email message
On Error Resume Next
With OutMail
.to = "someone@gmail.com"
.Subject = "Country Population Data " & Format(Date, "mm-dd-yy")
.Display
Set wordDoc = OutMail.GetInspector.WordEditor
wordDoc.Range.PasteandFormat wdChartPicture
.HTMLBody = "<body style=font-size:11pt;font-family:Calibri>" & _
"<p><font style=font-size:11pt;font-family:Calibri><b>Lorem ipsum dolor sit amet, consectetur adipiscing elit," & _
"sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Vitae ultricies leo integer malesuada nunc.</b></p>" & _
"<p><font style=font-size:9pt;font-family:Calibri>Lorem ipsum dolor sit amet, consectetur adipiscing elit," & _
"sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.</p>" & _
"<p><font style=font-size:9pt;font-family:Arial;color:#595959><i>Lorem ipsum dolor sit amet, consectetur adipiscing elit," & _
"sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Amet consectetur adipiscing elit ut. Mattis aliquam faucibus purus in massa tempor." & _
"Hendrerit dolor magna eget est.</i></font></p>" & .HTMLBody
End With
On Error GoTo 0
Set OutApp = Nothing
Set OutMail = Nothing
End Sub
当宏编译时,显示的电子邮件如下所示:
然而,我想要的结果是:
有人能帮我找出我做错了什么吗?
2条答案
按热度按时间ffscu2ro1#
试试这个:
我添加了一个
lastBodyStr
,它可以保存您的签名(如果您有签名),将原始的.HTMLBody
更改为textStr
,并取出& .HTMLBody
,然后将.HTMLBody
设置为所需的顺序w8ntj3qf2#
使用Word对象模型和
HTMLBody
属性按以下方式设置邮件正文时:我建议您确保将内容粘贴到HTML文档中,而不是依赖于Outlook的内置功能。
这意味着
HTMLBody
属性返回一个格式良好的HTML文档。如果您需要在那里添加内容,您需要首先找到正确的位置。例如,如果您需要将内容粘贴在邮件正文的开头,则可能需要找到开始的<body>
标记,或者如果您需要将内容粘贴在后面(最后),则可能需要找到结束的</body>
标记。