让自己开发的VBA应用能够批量发送邮件(可带多个附件）_vba批量发送带附件的邮件

当我们开发了一个VBA应用，很多时候需要让它能够自动批量发送邮件。这时候，我们就需要使用到CDO了。CDO全称Collaboration Data Objects，即协作数据对象，是Office 软件不在产品安装的一部分。它是通过基于COM的API提供对Outlook兼容对象的访问的包。CDO有多个组件，其中Message组件是邮件组件，使用其发送邮件是非常快速的，而且不需要任何附加的安装。
对于一封邮件，通常有邮件标题、发件人、收件人、抄送人、邮件正文、邮件附件等要素。我们就以这几个要素为参数，来设计一个能够发送邮件的函数。
要实现这个函数其实很简单，主要有以下几步：

1） 创建一个CDO.MESSAGE对象。
2） 给CDO对象初始化。将上面提到的邮件主要要素赋给这个CDO对象。
3） 定义STUI为微软服务器网址
4） 配置发送服务器的信息，包括SMTP服务器地址、服务器端口、发送端口、发送方邮箱名称，发送方邮箱密码等。
5） 使用CDO.MESSAGE对象的send发送邮件
6） 释放对象。

对，就这么简单。有以上几步，我们的VBA应用就可以随意批量发送邮件了。下面是一个实测可用的实例。只要将第4步中的SMTP服务器地址、发送方邮箱和密码更改成开发者的实际信息，就能成功发送了。

Public Function MyVbaMail(emsubject As Variant, emfrom As Variant, emto As Variant, emcc As Variant, emhtmlbody As Variant, ByRef emattachment As Variant)


Dim cm As Variant
Set cm = CreateObject("cdo.message") '创建CDO对象

cm.from = emfrom '设置发信人的邮箱"
cm.To = emto '设置收信人的邮箱，多个邮箱之间用分号隔开
cm.cc = emcc '设置抄送人的邮箱
cm.Subject = emsubject '设定邮件的主题
'cm.TextBody =  '邮件正文，使用文本格式发送邮件
cm.bodyPaRT.Charset = "UTF-8" '定义国际通用字体
cm.htmlbody = emhtmlbody '使用html格式

For i = 1 To UBound(emattachment)
    If emattachment(i) <> "" Then
    cm.AddAttachment emattachment(i) '添加附件
    End If
Next

STUl = "http://schemas.microsoft.com/cdo/configuration/" '微软服务器网址
With cm.Configuration.Fields
    .Item(STUl & "smtpserver") = "smtp.xxxx.com "         '发件人SMTP服务器地址
    .Item(STUl & "smtpserverport") = 25             '发件人SMTP服务器端口
    .Item(STUl & "sendusing") = 2                      '发送端口
    .Item(STUl & "smtpauthenticate") = 1      '需要提供用户名和密码，0是不提供           '
    .Item(STUl & "sendusername") = "xxxx@xxx.xxx"      '发送方邮箱名称
    .Item(STUl & "sendpassword") = "xxxxx"            '发送方邮箱密码
    .Update
End With
cm.Send '执行发送

Set cm = Nothing '发送成功后释放对象

End Function

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36