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= "Hi all, 

Here comes the daily work reminder summary.

"

'超链接
linkpath= "\\XXXXXXXXXX\Test book.xlsx"
linkstr = "" & """" & linkpath & """" & ">" & linkpath & "<br />
"

'插入桌面上的2.bmp这张图片
picstr = "" & """" & "file://" & Environ("userprofile") & "/Desktop/2.bmp" & """" & ">

"

'插入表格
tablestr = "
     1
    
   
   
    
     2
    
   
  
  
   
    
     3
    
   
   
    
     4
    
   
  
  
   
    
     5
    
   
   
    
     6
    
   
  
 
"

'插入签名
conhtml = "Kind & Best regards
"
conhtml = conhtml & Application.UserName & "

"
conhtml = conhtml & "Software Engineer
"
conhtml = conhtml & "XXXXXX Shenzhen Ltd.

"
conhtml = conhtml & "
Morningstar.Illuminating investing worldwide.
"
conhtml = conhtml & "" & LCase(Replace(Application.UserName, " ", ".")) & "@XXXXXX.com
"
conhtml = conhtml & "
30F, Tower A, Donghai International Center 7888 Shennan Road, Futian district,Shenzhen, Guangdong Province, China 518040
"
conhtml = conhtml & "conhtml = conhtml & "c=qrd1rYdJNb4QhfvJv5PebOPglYwfSMJ71NR_1HMKptQ&r=KR0eD0B-s1Y8uBImB7e6xdoONGxvbC6Yp3D6pV7YgBk&m=Q5CQH8XdkDZRQoP3oACw3HAsB1jk2_pkuhA-6dXRE6c&s=Hay_CFeBZJYJDybQbz3xbsOrcOqJbYn2yE0xCxeWyJA&e="" target=""_blank"">https://www.baidu.com
"
conhtml = conhtml & "Please consider the environment before printing.
"
conhtml = conhtml & "
"
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 & ""
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 = "" & "'1'" & " cellspacing=" & "'0'" & " style=" & "'border-collapse:collapse'" & ">"
 getTable = getTable & ""DoUntil j = RowCount + 1DoUntil ThisWorkbook.Sheets(1).Cells(j, i) = ""
     getTable = getTable & ""
     i = i + 1Loop
   getTable = getTable & ""
i = 1
j = j + 1Loop
getTable = getTable & "

 
    
" & " align=" & "'center'" & " height=30" & " width=100" & " style=" & "'font-size: 10pt; font-family: Verdana;" & " valign=" & "'center'" & ">"
     getTable = getTable & ThisWorkbook.Sheets(1).Cells(j, i) & "
   

"
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

 

转载于:https://www.cnblogs.com/JTCLASSROOM/p/10824353.html