想利用VBA自动创建/发送OUTLOOK邮件,可以借助MailItem的Body属性或HTMLBody属性,代码模板如下:
Dim objOutlook As Outlook.Application '需要引用Microsoft Outlook 16.0 Object Library对象模型 Dim objMail As MailItem Set objOutlook = New Outlook.Application Set objMail = objOutlook.CreateItem(olMailItem) With objMail .To = "XXXXXXXXXX.com" '收信的人 .CC = "" '抄送的人 .BCC = "" '暗抄送的人 .Attachments.Add ThisWorkbook.FullName '使用多个.Attachments.Add语句可以添加多个附件 .Subject = "Test Email" '邮件标题
.Body = "Hello," & vbCrLf & vbCrLf & "This is a test email, please do not respond." & vbCrLf & vbCrLf & "Best regards," '邮件正文 .Display '将邮件显示出来 .Save '保存邮件,使用此属性可以在outlook中的drafts看到创建的邮件 .Send '发送邮件 End With Set objMail = Nothing Set objOutlook = Nothing
上述代码中的属性可以按需设置,邮件正文显示内容比较单一,如果想实现邮件内容中有表格,有超链接,有好看的签名,有图片等等,可以使用HTMLBody属性替代Body属性,这时候编写正文内容就像是在编写一个小型的网页,需要稍微懂些html和css,甚至javascript的基础知识,然后把写好的网页代码放进字符串传给HTMLBody属性即可。
'正文 body= "<Font Face=Verdana Size=""2"" Color=black>Hi all, <br /><br />Here comes the daily work reminder summary.<br /><br />" '超链接 linkpath= "\\XXXXXXXXXX\Test book.xlsx" linkstr = "<a href=" & """" & linkpath & """" & ">" & linkpath & "</a><br /><br />" '插入桌面上的2.bmp这张图片 picstr = "<img src=" & """" & "file://" & Environ("userprofile") & "/Desktop/2.bmp" & """" & "><br /><br />" '插入表格 tablestr = "<table bordercolor=""#000000"" style=""width:50%;"" border=""1"" cellspacing=""0"" cellpadding=""2""><tbody><tr><td><div align=""center""> <strong><span style=""font-family:Verdana;"">1</span></strong><br /> </div> </td> <td> <div align=""center""> <strong><span style=""font-family:Verdana;"">2</span></strong><br /> </div> </td> </tr> <tr> <td> <div align=""center""> <span style=""font-family:Verdana;"">3</span><br /> </div> </td> <td> <div align=""center""> <span style=""font-family:Verdana;"">4</span><br /> </div> </td> </tr> <tr> <td> <div align=""center""> <span style=""font-family:Verdana;"">5</span><br /> </div> </td> <td> <div align=""center""> <span style=""font-family:Verdana;"">6</span><br /> </div> </td> </tr> </tbody></table><br />"
'插入签名
conhtml = "<Font Face=Verdana Size=""2"" Color=black>Kind & Best regards<br />"
conhtml = conhtml & Application.UserName & "<br /><br />"
conhtml = conhtml & "Software Engineer<br />"
conhtml = conhtml & "XXXXXX Shenzhen Ltd.<br /><br />"
conhtml = conhtml & "<p align=""left"" style=""text-align:left;""><font size=2 color=#FF69B4>Morningstar.Illuminating investing worldwide.</font><br />"
conhtml = conhtml & "<a href=""mailto:" & LCase(Replace(Application.UserName, " ", ".")) & "@XXXXXX.com""><u>" & LCase(Replace(Application.UserName, " ", ".")) & "@XXXXXX.com</u></a></p>"
conhtml = conhtml & "<p class=""pp"" align=""left"" style=""text-align:left;margin:0px"">30F, Tower A, Donghai International Center 7888 Shennan Road, Futian district,Shenzhen, Guangdong Province, China 518040<br />"
conhtml = conhtml & "<a href=""https://urldefense.proofpoint.com/v2/url?u=http-3A__scanmail.trustwave.com_-3Fc-3D4394-26d-3DjcvQ2CggEsqkdWCEgMZJITyd-5FHlzGhNy8Qj-5F-5FWNFCA-26u-3Dhttp-253a-252f-252fcn-252emorningstar-252ecom-252f&d=DwMFAg&"
conhtml = conhtml & "c=qrd1rYdJNb4QhfvJv5PebOPglYwfSMJ71NR_1HMKptQ&r=KR0eD0B-s1Y8uBImB7e6xdoONGxvbC6Yp3D6pV7YgBk&m=Q5CQH8XdkDZRQoP3oACw3HAsB1jk2_pkuhA-6dXRE6c&s=Hay_CFeBZJYJDybQbz3xbsOrcOqJbYn2yE0xCxeWyJA&e="" target=""_blank"">https://www.baidu.com</a><br />"
conhtml = conhtml & "<font size=1 color=""green"">Please consider the environment before printing.</font></p>"
conhtml = conhtml & "<p class=""pp"" style=""color:#9D9D9D;font-size:11px;margin:0px"">"
conhtml = conhtml & "This e-mail contains privileged and confidential information and is intended only"
conhtml = conhtml & " for the use of the person(s) named above. Any dissemination, distribution, or"
conhtml = conhtml & " duplication of this communication without prior written consent from"
conhtml = conhtml & " XXXXXX is strictly prohibited. If you have received this message in error,"
conhtml = conhtml & " please contact the sender immediately and delete the materials from any computer."
conhtml = conhtml & "</p></Font>"
With objMail .To = "XXXXXXXXXX.com" .Subject = "Test Email" .HTMLBody = body & tablestr & linkstr & conhtml .Display End With
如果插入的表格是工作表里面的数据,可以单独写一个函数循环读写单元格,调用时.HTMLBody = body & getTable & linkstr & conhtml
Function getTable() As String i = 1 j = 1 RowCount = ThisWorkbook.Sheets(1).Range("a999999").End(xlUp).Row getTable = "<table border=" & "'1'" & " cellspacing=" & "'0'" & " style=" & "'border-collapse:collapse'" & ">" getTable = getTable & "<tr>" Do Until j = RowCount + 1 Do Until ThisWorkbook.Sheets(1).Cells(j, i) = "" getTable = getTable & "<td " & " align=" & "'center'" & " height=30" & " width=100" & " style=" & "'font-size: 10pt; font-family: Verdana;" & " valign=" & "'center'" & ">" getTable = getTable & ThisWorkbook.Sheets(1).Cells(j, i) & "</td>" i = i + 1 Loop getTable = getTable & "</tr>" i = 1 j = j + 1 Loop getTable = getTable & "</tr></table><br />" End Function
这是工作表中的表格:
这是邮件中的表格:
以这种方法写入表格只能写入单元格中的内容,如果想要把单元格的格式也照搬进邮件,可以在表格的html代码中手动写好格式代码。
如果签名部分的html代码不好写,或者实现效果不佳,也可以采用你的OUTLOOK设置的默认签名,方法如下:
objMail.Display signature = objMail.HTMLBody With objMail .To = "XXXXXXXXXX.com" .Subject = "Test Email" .HTMLBody = body & tablestr & linkstr & signature End With