摘要：《VBA信息获取与处理》教程(版权10178984)是我推出第六套教程，目前已经是第一版修订了。这套教程定位于最高级，是学完初级，中级后的教程。这部教程给大家讲解的内容有：跨应用程序信息获得、随机信息的利用、电子邮件的发送、VBA互联网数据抓取、VBA延时操作
《VBA信息获取与处理》教程(版权10178984)是我推出第六套教程，目前已经是第一版修订了。这套教程定位于最高级，是学完初级，中级后的教程。这部教程给大家讲解的内容有：跨应用程序信息获得、随机信息的利用、电子邮件的发送、VBA互联网数据抓取、VBA延时操作，剪贴板应用、Split函数扩展、工作表信息与其他应用交互，FSO对象的利用、工作表及文件夹信息的获取、图形信息的获取以及定制工作表信息函数等等内容。程序文件通过32位和64位两种OFFICE系统测试。是非常抽象的，更具研究的价值。
教程共两册,二十个专题。今日分享内容是：VBA信息获取与处理专题五第二节：根据地址不同分发简单邮件【分享成果，随喜正能量】224 面对他人的优秀，智者随喜，愚者比较。随喜他人的优秀，心里生出的是欢喜与向往，与他人的优秀做比较，心里生出的则是傲慢与偏见。要相信每个人都会有自己的闪光点，以一颗平等心，真诚的随喜他人的优秀，见贤思齐，修好自己的本领，静待自我人生的高光时刻。
在上一讲中我们讲了简单邮件的发送，我们这讲的内容是讲解如何根据工作表的指定地址分发邮件。
如下图：
上述表格是参加一次会议的各部门人员安排，需要各部门长接到邮件后按人数把人员反馈，如果群发那就太low了，我们要单独给各个部门。这节我们就来实现这个课题。
1 分发邮件的思路分析为了实现我们刚才提到的目的，我们先把整个表研究一下，首列是收件人的地址，第二列到第第四列是部门，最后一列是要求的人数。
我们将邮件的内容设计成如下简单的格式，根据需要重复发送；
部门+领导+称呼：
贵部门参加会议的人数为：*人,请安排。
当然，以上的格式需要用HTML语言来编写。
上一讲中，我们利用了CDO完成邮件发送的简单过程，我们体会到，其中参数非常多，为此，我封装了一个自定义函数，来完成邮件发送的任务，这样只需在主程序中完成这些参数的定义即可。我们先看这个自定义函数SendEMailC的代码：
Function SendEMailC(Subject As String, FromAddress As String, ToAddress As String, _
MailBody As String, _
SMTP_Server As String, _
BodyFileName As String, _
Mailsendpassword As String, _
Optional Attachments As Variant = Empty) As Boolean
'常量的命名
Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
Const cdoSendUsingPort = 2
Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Const cdoSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
Const cdoSMTPAuthenticate = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
Const cdoBasic = 1
Const cdoSendUserName = "http://schemas.microsoft.com/cdo/configuration/sendusername"
Const cdoSendPassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
Dim objConfig
Dim objMessage
Dim Fields
' 确保所需参数存在且有效
If Len(Trim(Subject)) = 0 Then
SendEMailC = False
Exit Function
End If
If Len(Trim(FromAddress)) = 0 Then
SendEMailC = False
Exit Function
End If
If Len(Trim(SMTP_Server)) = 0 Then
SendEMailC = False
Exit Function
End If
'传入的参数
' Subject: 电子邮件的主题行.
' FromAddress: 是发送电子邮件的地址
' ToAddress: 是电子邮件将发送到的地址
' MailBody: 要作为邮件正文的文本.
' SMTP_Server: 是传出邮件服务器的名称.
' BodyFileName: 是将用作消息正文的文本文件的名称.
' Attachments 要附加到邮件的单个文件名或文件名数组.
' Mailsendpassword 确认码或者密码
'引用
Set objMessage = CreateObject("CDO.Message")
'对象的引用
Set objConfig = objMessage.Configuration
Set Fields = objConfig.Fields
With Fields
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = SMTP_Server '
.Item(cdoSMTPServerPort) = 25
.Item(cdoSMTPConnectionTimeout) = 10
.Item(cdoSMTPAuthenticate) = cdoBasic
.Item(cdoSendUserName) = FromAddress '
.Item(cdoSendPassword) = Mailsendpassword '
.Update
End With
'邮件的设置
With objMessage
'.BodyPart.Charset = "shift-jis" '
.To = ToAddress '
.From = FromAddress '
.Subject = Subject '
' .htmlBody '
'假如传入的参数有内容则引用，也可以从文件中导入
If MailBody vbNullString Then
.HtmlBody = MailBody
Else
If BodyFileName vbNullString Then
If Dir(BodyFileName, vbNormal) vbNullString Then
' 从文件BodyFileName导入正文文本
FNum = FreeFile
S = vbNullString
Body = vbNullString
Open BodyFileName For Input Access Read As #FNum
Do Until EOF(FNum)
Line Input #FNum, S
Body = Body & vbNewLine & S
Loop
Close #FNum
.HtmlBody = Body
Else
'BodyFileName 没有发现
SendEMailC = False
Exit Function
End If
End If
End If
'添加附件
If IsArray(Attachments) = True Then
' 附加附件的所有文件.
For N = LBound(Attachments) To UBound(Attachments)
' 如果为数组将每个文件传入
If Attachments(N) vbNullString Then
If Dir(Attachments(N), vbNormal) vbNullString Then
.AddAttachment Attachments(N)
End If
End If
Next
Else
' 不为数组则传入文件
If Attachments vbNullString Then
If Dir(CStr(Attachments), vbNormal) vbNullString Then
.AddAttachment Attachments
End If
End If
End If
'判断邮件是否发送成功
On Error Resume Next
Err.Clear
.Send
tt = Err.Number
If Err.Number = 0 Then
SendEMailC = True
Else
SendEMailC = False
Exit Function
End If
End With
Set Fields = Nothing
Set objMessage = Nothing
Set objConfig = Nothing
End Function
代码的截图：
代码的讲解：这个函数我在后面还有讲解。
我20多年的VBA实践经验，全部浓缩在下面的各个教程中，教程学习顺序：
来源：VBA语言专业教育
