VBA发送邮件函数

loquat · 发表于 2016-12-24 12:50

网上主流的发邮件例子是使用JMail组件，实际上没必要
使用系统自带的cdo组件就可以实现发送邮件

本函数可以发送单个附件，或者发送附件列表。（未考虑邮箱服务器支持的附件总大小。）

调用例子：

Dim msg as Boolean
msg = SendMail("loquat@qq.com","xbssjkdklkagka","loquat@qq.com","标题","正文",,True,"c:\1.txt")

复制代码

Public Function SendMail(ByVal 发送方邮箱$, ByVal STMP密码$, ByVal 目标邮箱$, ByVal 标题$, ByVal 正文$, Optional 抄送邮箱$ = "", Optional ByVal 使用SSL As Boolean = False, Optional ByVal 附件) As Boolean
' 参数说明:
' 1.发送方邮箱: 发送邮件的邮箱帐号
' 2.STMP密码: 发送邮件的邮箱密码或SMTP密码，视邮件服务商而定
' 3.目标邮箱: 接收邮件的主要邮箱地址，可以是多个目标
' 4.抄送邮箱: 接收邮件的抄送邮箱地址，可以是多个目标
' 5.标题: 邮件主题
' 6.正文: 邮件正文
' 7.使用SSL: 是否SSL加密，视邮件服务商而定
' 8.附件: 邮件附件，传入字符串（单一附件）或者[b]一维数组（多个附件）[/b]
'On Error Resume Next
Dim arrID, MS_Space$, i&, aTypeName$
Dim Email As Object
arrID = Split(发送方邮箱, "@")
MS_Space = "http://schemas.microsoft.com/cdo/configuration/"
Set Email = CreateObject("CDO.Message")
Email.From = 发送方邮箱
Email.To = 目标邮箱
If 抄送邮箱 <> "" Then Email.CC = 抄送邮箱
If 标题 <> "" Then Email.Subject = 标题
If 正文 <> "" Then Email.Textbody = 正文
aTypeName = TypeName(附件) '判断变量类型
If aTypeName = "String" Then '传入字符串
If Dir(附件) <> "" Then '文件存在
Email.AddAttachment 附件 '单个附件
End If
ElseIf aTypeName = "String()" Then
For i = LBound(附件) To UBound(附件) '循环添加多个附件
If Dir(附件(i)) <> "" Then '文件存在
Email.AddAttachment 附件(i)
End If
Next
End If
With Email.Configuration.Fields
.Item(MS_Space & "sendusing") = 2 '发送方式：1代表通过本机SMTP服务发信，2代表通过端口访问远程SMTP服务器发信
.Item(MS_Space & "smtpserver") = "smtp." & arrID(1) 'SMTP服务器域名或IP,企业邮箱为 mail 前缀
.Item(MS_Space & "smtpauthenticate") = 1 'SMTP服务器验证密码方式：0代表匿名，1代表基本验证，2代表NTLM方式验证
If 使用SSL = False Then
.Item(MS_Space & "smtpserverport") = 25
Else
.Item(MS_Space & "smtpserverport") = 465
.Item(MS_Space & "smtpusessl") = True
End If
.Item(MS_Space & "stmpconnectiontimerout") = 60 '设置连接超时，单位秒
.Item(MS_Space & "sendusername") = 发送方邮箱
.Item(MS_Space & "sendpassword") = STMP密码
' 当使用本机SMTP服务发信时，需要填写代理地址和端口号
' .Item(MS_Space & "urlproxyserver") = "61.155.220.244:80"
' .Item(MS_Space & "urlproxybypass") = ""
' .Item(MS_Space & "urlgetlatestversion") = True
.Update
End With
Email.Send
SendMail = (err.Number = 0)
Debug.Print err.Description
Set Email = Nothing
End Function

复制代码

loquat · 发表于 2016-12-24 12:54

本函数不一定通用，但是大部分情况下应该可以使用。
遇到问题先查一下邮箱服务器的调用说明。

413191246se · 发表于 2016-12-26 17:17

虽然也是看不懂，但还是要强烈支持老朋友楼主 loquat ！
早在 10来年之前，我看过韩-国一个电视剧，就是，也许叫《人鱼公主》或什么，就是在 Word 中写完文字就发送邮件，很羡慕，但是我试了在 Word 中，发不了，让填写服务器名，不会，此项功能不能用，可惜！

413191246se · 发表于 2016-12-26 20:36

老朋友，我再罗索几句：今天上午在把《标题2345自动设置》成功改写，但是中午一测试，速度不但未提升，反而下降一倍，就是，假设原来的速度是 1秒，现在是2秒了，慢了！——但是，下午我又仔细一看，原来有 3 个 r.select 未删除。删除后，速度马上上来了！原来的正常速度假设是 7秒，现在是 2秒；后来把各个标题的颜色屏蔽，速度又提升到 1.8X秒。——过去《标题2345》分别是用 Selection 对象进行查找设置格式的，现在把 2345 四个标题集成在一起，不用 Selection/Select 全用 Range，现在速度是 1.8X秒，前几天是 7秒，提升很大。

loquat · 发表于 2017-2-5 15:05

本帖最后由 loquat 于 2017-2-5 15:06 编辑

413191246se 发表于 2016-12-26 17:17
虽然也是看不懂，但还是要强烈支持老朋友楼主 loquat ！
早在 10来年之前，我看过韩-国一个电视剧，就是 ...

其实这个函数发送邮件，支持免费的邮箱服务，例如qq，网易，新浪，谷姐等等
前提是有开通smtp服务，发送邮件使用的密码是smtp授权密码，不是邮箱网页登陆密码
然后就看邮箱的smtp服务说明，例如我已知qq和gmail就是需要开启usessl参数的
这个参数在函数里我已经内置了
还有一种，就是如果你假设了本地邮件服务器，可以用本地服务器发送邮件。
解除后面那些注释掉的部分，然后填写上邮箱服务器的参数

ammyc · 发表于 2017-2-24 11:55

好好学习天天向上

whatyang · 发表于 2017-3-1 16:19

很好用，但用代理的那段不知道怎么用。我在单位内网用foxmail在设置帐号后，还要设置用http代理服务器10.32.239.11，端口80，如果在这样的环境下，应该怎么写呢？

loquat · 发表于 2017-3-2 12:15

whatyang 发表于 2017-3-1 16:19
很好用，但用代理的那段不知道怎么用。我在单位内网用foxmail在设置帐号后，还要设置用http代理服务器10.32 ...

这一段我没有条件测试，应该就是填写IP地址和端口号进去就可以用吧

wdpfox · 发表于 2018-1-4 16:26

比较高深, 学习中..................谢谢分享!

wyy623 · 发表于 2018-11-6 20:34

虽然也是看不懂，但还是要强烈支持老朋友楼主 loquat ！

		自动登录	找回密码
密码			免费注册

[分享] VBA发送邮件函数

评分