VBA学习资料分享-2

想利用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&amp;d=DwMFAg&amp;"
conhtml = conhtml & "c=qrd1rYdJNb4QhfvJv5PebOPglYwfSMJ71NR_1HMKptQ&amp;r=KR0eD0B-s1Y8uBImB7e6xdoONGxvbC6Yp3D6pV7YgBk&amp;m=Q5CQH8XdkDZRQoP3oACw3HAsB1jk2_pkuhA-6dXRE6c&amp;s=Hay_CFeBZJYJDybQbz3xbsOrcOqJbYn2yE0xCxeWyJA&amp;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