VB实现自动发送邮件

' 注意：以单引号'开头的行为注释

' fdt为今日日期的字符串，比如 '2014-11-13'，可用于附件名字里和邮件标题里

' receiptions 为收件人列表，多个收件人之间用分号隔开

' ccreceiptions 为抄送人列表，多个抄送人之间用分号隔开

' Subject 为邮件标题

' Body 为邮件正文

' Attachments 为附件列表，每个附件都需附带路径并用逗号隔开。

 

 

' 以下代码可自定义修改

fdt = FormatDateTime(Date)

receiptions = "xxx@cn.xxx.com"

ccreceiptions="xxxx@cn.xxx.com;xxx@cn.xxx.com;xx@cn.xxx.com"

Subject = "xx的Usarp入库日志 " & fdt

Body = "附件是xx的Usarp数据导入到Oracle数据库，在"& fdt & "执行的日志报告，请查收！"

Attachments = Array("F:\xx\log4mail.log") 

' 以下代码无需修改

Dim xOutLook

Dim xMail

 

On Error Resume Next

Set xOutLook = GetObject(, "Outlook.Application")

If xOutLook Is Nothing Then

 Set xOutLook = CreateObject("Outlook.Application")

End If

Set xMail = xOutLook.CreateItem(olMailItem)

With xMail

 .Display

 Dim signature

 signature = .HTMLBody

 .To = receiptions

 .Cc=ccreceiptions

 .Subject = Subject

 .HTMLBody = Body

.Importance = olImportanceHigh 

 

 Dim xDoc

 Set xDoc = xMail.Application.ActiveInspector.WordEditor

 

 If IsArray(Attachments) Then

 Dim attachment

 For Each attachment In Attachments

 .Attachments.Add attachment

 Next

 End If

 

 .HTMLBody = .HTMLBody & signature

 .Send

End With