大家好,我们今日讲解“利用其他邮箱服务器发送电子邮件”，这节内容是“VBA信息获取与处理”教程中第五个专题“利用VBA发送电子邮件”的第三节。
第三节 利用其他邮箱服务器发送电子邮件
在第一和第二节中，我讲解了如何实现利用EXCEL属性设置完成邮件的发送，但很多时候，我们并不是喜欢用OUTLOOK来发送邮件，你可能用的是126的邮箱，可能用的是163的邮箱，等等，那么如何实现利用这些邮件服务器来发送邮件呢？我们这节的内容就给大家以很好的解决方案。
这是我根据我多年的经验编写的第六部教程，这些教程不是单纯的知识讲解更主要的经验的传递，所有的教程中体现的是“积木编程”的思路，大家可以利用我推出的代码，用于实际工作中，尽可能是去修改我推出的代码为自己所用，而不是自己去写代码，那样会很不准确，比如有的朋友让我给测试一段无法运行的代码，我测试后发现就是因为其中一个nothing写成了nohting,更有甚者，是由于逗号的全角问题不能通过，这些问题大家要尽可能的去避免。这讲的代码同样，不要大家去一个个的录入字符，要去用我的代码，然后去修正为自己的设置即可。
下面言归正传，我们讲解利用其它邮件服务器完成我们的邮件发送，我要发送的是包含两个附件的邮件，同时，邮件的主题内容部分是我在事前已经写好到一个文本文件中。我要将这个邮件利用指定的邮箱发送给指定的邮箱。
1 利用邮箱服务器发送邮件的思路分析
由于要利用邮件服务器来完成邮件的发送工作，所以我们要完成对邮件服务器以下必要参数的设置，如发送邮件的邮箱地址；发送邮箱的服务器；发送邮箱的登陆密码；收件人的邮箱地址等等，这个过程看起来是较复杂的，但确实必不可少的关键步骤。除了要完成 上述设置外还要去其他的一些操作上必要的工作，为了能顺利的实现我们任务，我们大概的做一个清单：
1）代码需要引用Microsoft CDO for Windows 2000库，来完成我们的邮件发送工作。
2）由于用到的参数较多，有发送邮件的邮箱地址；发送邮箱的服务器；发送邮箱的登陆密码；收件人的邮箱地址；附件的引用；邮件正文的读取文件，等等，所以在代码的实现过程中我们将建立一个function过程来实现邮件的发送。如果邮件发送程序将返回TRUE,如果不成功那么返回false.
3）在主程序过程中提供上述的参数,并接受函数的返回值，如果为true那么就提示用户邮件发送成功，否则提示没有成功。
4）在function过程中要校验各个参数是否正常。
5）在function过程中，要打开需要写入邮件正文的文本文件，然后读取，写入邮件。
6） 在function过程中要完成附件的添加。在主程序工程中将把每个附件的名称（full name）设置成数组的元素，在function过程中要先判断输入的是否为数组，如果为数组那么拆分数组后逐个添加附件。
2 利用邮箱服务器发送邮件过程中的主程序代码
思路确定之后，我们要一步步的完成我们的工作，首先要完成主程序过程的代码设计，我们在上述思路的清点过程中已经明确了主程序要实现的工作有：必要参数的传递和接受fountion过程的返回值，下面看代码的过程：
Sub myNZB()
myBRR = Array("E:\NZ\文章\06 VBA信息获取与处理\005关于安全生产的通知.TXT", "E:\NZ\文章\06 VBA信息获取与处理\005关于安全生产的通知.docx")
NN = SendEMailB(Subject:="My Email", FromAddress:="VBA9668@", _
ToAddress:="nesang@", MailBody:="", _
SMTP_Server:="", BodyFileName:="E:\NZ\文章\06 VBA信息获取与处理\005关于安全生产的通知.TXT", Attachments:=myBRR)
If NN = True Then
MsgBox "邮件发送成功!"
Else
MsgBox "邮件没有发送成功!"
End If
End Sub
代码的截图：
代码的讲解：
1） myBRR = Array("E:\NZ\文章\06 VBA信息获取与处理\005关于安全生产的通知.TXT", "E:\NZ\文章\06 VBA信息获取与处理\005关于安全生产的通知.docx") 这句代码将要添加的附件放到了数组中。
2）NN = SendEMailB(Subject:="My Email", FromAddress:="VBA9668@", _
ToAddress:="nesang@", MailBody:="", _
SMTP_Server:="", BodyFileName:="E:\NZ\文章\06 VBA信息获取与处理\005关于安全生产的通知.TXT", Attachments:=myBRR)
这段代码是利用SendEMailB 函数来完成邮件的发送。传递的参数有：
Subject:="My Email"
FromAddress:=VBA9668@
ToAddress:="nesang@",
MailBody:="",
SMTP_Server:=""
BodyFileName:="E:\NZ\文章\06 VBA信息获取与处理\005关于安全生产的通知.TXT"
Attachments:=myBRR
下面我们还会提到各个参数的意义。
3）If NN = True Then
MsgBox "邮件发送成功!"
Else
MsgBox "邮件没有发送成功!"
End If
上述代码根据返回值的不同，从而判断邮件是否发送成功。
3 利用邮箱服务器发送邮件过程中FUNCTION过程的实现代码
在上面的讲解中利用了SendEMailB 这个函数过程来发送邮件，我们来看看这个过程的具体实现步骤，代码如下：
Function SendEMailB(Subject As String, FromAddress As String, ToAddress As String, _
MailBody As String, _
SMTP_Server As String, _
BodyFileName As String, _
Optional Attachments As Variant = Empty) As Boolean
常量的命名
Const cdoSendUsingMethod = "/cdo/configuration/sendusing"
Const cdoSendUsingPort = 2
Const cdoSMTPServer = "/cdo/configuration/smtpserver"
Const cdoSMTPServerPort = "/cdo/configuration/smtpserverport"
Const cdoSMTPConnectionTimeout = "/cdo/configuration/smtpconnectiontimeout"
Const cdoSMTPAuthenticate = "/cdo/configuration/smtpauthenticate"
Const cdoBasic = 1
Const cdoSendUserName = "/cdo/configuration/sendusername"
Const cdoSendPassword = "/cdo/configuration/sendpassword"
Dim objConfig
Dim objMessage
Dim Fields
确保所需参数存在且有效
If Len(Trim(Subject)) = 0 Then
SendEMailB = False
Exit Function
End If
If Len(Trim(FromAddress)) = 0 Then
SendEMailB = False
Exit Function
End If
If Len(Trim(SMTP_Server)) = 0 Then
SendEMailB = False
Exit Function
End If
传入的参数
Subject: 电子邮件的主题行.
FromAddress: 是发送电子邮件的地址
ToAddress:是电子邮件将发送到的地址
MailBody: 要作为邮件正文的文本.
SMTP_Server: 是传出邮件服务器的名称.
BodyFileName: 是将用作消息正文的文本文件的名称.
Attachments要附加到邮件的单个文件名或文件名数组.
引用
Set objMessage = CreateObject("CDO.Message")
对象的引用
Set objConfig = objMessage.Configuration
Set Fields = objConfig.Fields
With Fields
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = "" <smtp邮件发送服务器>
.Item(cdoSMTPServerPort) = 25
.Item(cdoSMTPConnectionTimeout) = 10
.Item(cdoSMTPAuthenticate) = cdoBasic
.Item(cdoSendUserName) = FromAddress <发送者邮件地址>
.Item(cdoSendPassword) = "1QAZzaq1" <发送者邮件密码>
.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 没有发现
SendEMailB = False
Exit Function
End If
End If MailBody and BodyFileName 都为空
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
SendEMailB = True
Else
SendEMailB = False
Exit Function
End If
End With
Set Fields = Nothing
Set objMessage = Nothing
Set objConfig = Nothing
End Function
代码的截图：
代码的解读：
1） 确保所需参数存在且有效
If Len(Trim(Subject)) = 0 Then
SendEMailB = False
Exit Function
End If
If Len(Trim(FromAddress)) = 0 Then
SendEMailB = False
Exit Function
End If
If Len(Trim(SMTP_Server)) = 0 Then
SendEMailB = False
Exit Function
End If
传入的参数
Subject: 电子邮件的主题行.
FromAddress: 是发送电子邮件的地址
ToAddress:是电子邮件将发送到的地址
MailBody: 要作为邮件正文的文本.
SMTP_Server: 是传出邮件服务器的名称.
BodyFileName: 是将用作消息正文的文本文件的名称.
Attachments要附加到邮件的单个文件名或文件名数组.
上述代码确保了各个参数的有效性，同时给出了各个参数的意义。当所给的参数是无效的将不能发送邮件，这个很好理解的例如发送邮箱和接受邮箱是空的话自然不能发送邮件的。
2） Set objMessage = CreateObject("CDO.Message") 这句代码是对CDO的引用，我们发送邮件也是依据这个引用来完成的。
3）With Fields
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = "" <smtp邮件发送服务器>
.Item(cdoSMTPServerPort) = 25
.Item(cdoSMTPConnectionTimeout) = 10
.Item(cdoSMTPAuthenticate) = cdoBasic
.Item(cdoSendUserName) = FromAddress <发送者邮件地址>
.Item(cdoSendPassword) = "1QAZzaq1" <发送者邮件密码>
.Update
End With
以上过程是对邮件的设置包括发送邮件的服务器及密码，大家在利用的时候注意要修改为自己的邮箱及密码设置。
4）With objMessage
.BodyPart.Charset = "shift-jis" <邮件内容编码（日语可以用）>
.To = ToAddress <接收者邮件地址>
.From = FromAddress <发送者邮件地址,与上面设置相同>
.Subject = Subject <邮件主题>
.htmlBody <邮件内容>
上述代码是对邮件的设置，比较简单，这里不再多讲，下面将对邮件主题内容进行设置。
5）假如传入的参数有内容则引用，也可以从文件中导入
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 没有发现
SendEMailB = False
Exit Function
End If
End If MailBody and BodyFileName 都为空
End If
上述代码完成了邮件主题从另外的文件中进行内容读取的设置，如果有对Input语句不是十分理解的朋友可以参考我的其他教程，在数据库及准数据库中均有讲解。
6）添加附件
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
上述代码完成了对附件的添加过程，涉及到数组的拆分，文件名的判断，附件的添加。
7）判断邮件是否发送成功
On Error Resume Next
Err.Clear
.Send
tt = Err.Number
If Err.Number = 0 Then
SendEMailB = True
Else
SendEMailB = False
Exit Function
End If
上述代码完成了对邮件是否发送成功的判断，在整个发送过程中，如果没有发生错误，那么返回值是：SendEMailB = True，否则为false
4 利用邮箱服务器发送邮件的结果
通过主程序和函数过程的实现，我们终于可以完成邮件的发送了，如下图，我们点击运行按钮：
最后在nesang@ 邮箱中将收到，我们发出的邮件，如下图：
以上就是整个邮件发送的过程，这个工程中没有必要要求发送邮件的服务器是打开状态。
本节知识点回向：如何实现利用邮件服务器发送邮件？如何读取指定的文件放到邮件中？如果实现多附件的邮件发送？
本专题参考程序文件：005工作表.XLSM
VBA是利用Office实现自己小型办公自动化的有效手段，这是我对VBA的应用界定。在取代OFFICE新的办公软件没有到来之前，谁能在数据处理方面做到极致，谁就是王者。其中登峰至极的技能非VBA莫属！学习VBA是个过程，也需要经历一种枯燥的感觉，如太白诗云：众鸟高飞尽，孤云独去闲。相看两不厌，只有敬亭山。
“水善利万物而不争”，绵绵密密，微则无声，巨则汹涌。学习亦如此，知道什么是自己所需要的，不要蜷缩在一小块自认为天堂的世界里，待到暮年时再去做自欺欺人的言论。要努力提高自己，用一颗充满生机的心灵，把握现在，这才是进取。越是有意义的事情，困难会越多。愿力决定始终，智慧决定成败。不管遇到什么，都是风景。看淡纷争，看轻得失。茶，满也好，少也好，不要计较；浓也好，淡也好，其中自有值得品的味道。去感悟真实的时间，静下心，多学习，积累福报。而不是天天混日子，也不是天天熬日子。在后疫情更加严峻的存量残杀世界中，为自己的生存进行知识的储备，特别是新知识的储备。学习时微而无声，利用时则巨则汹涌。
我记得前自己初学VBA时，那时的资料甚少，只能看源码自己琢磨,真的很难。过去了，为了不让学习VBA的朋友重复我之前的经历，我根据自己多年VBA实际利用经验，推出了六部VBA专门教程。
第一套：VBA代码解决方案是VBA中各个知识点的讲解，覆盖绝大多数的VBA知识点，初学必备；
第二套：VBA数据库解决方案数据库是数据处理的专业利器，教程中详细介绍了利用ADO连接ACCDB和EXCEL的方法和实例操作，适合中级人员的学习。
第三套：VBA数组与字典解决方案数组和字典是VBA的精华，字典是VBA代码水平提高的有效手段，值得深入的学习，是初级及中级人员代码精进的手段。
第四套：VBA代码解决方案之视频是专门面向初学者的视频讲解，可以快速入门，更快的掌握这门技能。
第五套：VBA中类的解读和利用这是一部高级教程，讲解类的虚无与肉身的度化，类的利用虽然较少，但仔细的学习可以促进自己VBA理论的提高。
第六套教程：《VBA信息获取与处理》，这是一部高级教程，涉及范围更广，实用性更强，面向中高级人员。教程共二十个专题，包括：跨应用程序信息获得、随机信息的利用、电子邮件的发送、VBA互联网数据抓取、VBA延时操作，剪切板应用、Split函数扩展、工作表信息与其他应用交互，FSO对象的利用、工作表及文件夹信息的获取、图形信息的获取以及定制工作表信息函数等等内容。如需要可以可以WeChat: NZ9668
学习的过程也是修心的过程，修一个平静的心。在代码的世界中，心平静了，心情好了，身体自然而然就好。心静则正，内心里没有那么多邪知邪见，也就没有那么多妄想。利人就是利己。这些教程也是为帮助大家起航，助上我自己之力，我的上述教程是我多的经验的传递，大家可以根据以上资料1,3,2,6,5或者是4,3,2,6,5的顺序逐渐深入的逐渐学习。
每一分收获都是成长的记录，怎无凭，正是这种执着，成就了朝霞的灿烂。最后将一阙词送给致力于VBA学习的朋友,让大家感受一下学习过程的枯燥与执着：
浮云掠过，暗语无声，
唯有清风，惊了梦中啼莺。
望星，疏移北斗，
奈将往事雁同行。
阡陌人，昏灯明暗，
忍顾长亭。
多少VBA人，
暗夜中，悄声寻梦，盼却天明。
怎无凭！
分享成果，随喜正能量
