ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 2878|回复: 9

[分享] VBA发送邮件函数

[复制链接]

TA的精华主题

TA的得分主题

发表于 2016-12-24 12:50 | 显示全部楼层 |阅读模式
网上主流的发邮件例子是使用JMail组件,实际上没必要
使用系统自带的cdo组件就可以实现发送邮件

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

调用例子:
  1. Dim msg as Boolean
  2. msg = SendMail("loquat@qq.com","xbssjkdklkagka","loquat@qq.com","标题","正文",,True,"c:\1.txt")
复制代码
  1. Public Function SendMail(ByVal 发送方邮箱$, ByVal STMP密码$, ByVal 目标邮箱$, ByVal 标题$, ByVal 正文$, Optional 抄送邮箱$ = "", Optional ByVal 使用SSL As Boolean = False, Optional ByVal 附件) As Boolean
  2. '   参数说明:
  3. '   1.发送方邮箱:       发送邮件的邮箱帐号
  4. '   2.STMP密码:         发送邮件的邮箱密码或SMTP密码,视邮件服务商而定
  5. '   3.目标邮箱:         接收邮件的主要邮箱地址,可以是多个目标
  6. '   4.抄送邮箱:         接收邮件的抄送邮箱地址,可以是多个目标
  7. '   5.标题:             邮件主题
  8. '   6.正文:             邮件正文
  9. '   7.使用SSL:          是否SSL加密,视邮件服务商而定
  10. '   8.附件:             邮件附件,传入字符串(单一附件)或者[b]一维数组(多个附件)[/b]
  11.     'On Error Resume Next
  12.     Dim arrID, MS_Space$, i&, aTypeName$
  13.     Dim Email As Object
  14.     arrID = Split(发送方邮箱, "@")
  15.     MS_Space = "http://schemas.microsoft.com/cdo/configuration/"
  16.     Set Email = CreateObject("CDO.Message")
  17.     Email.From = 发送方邮箱
  18.     Email.To = 目标邮箱
  19.     If 抄送邮箱 <> "" Then Email.CC = 抄送邮箱
  20.     If 标题 <> "" Then Email.Subject = 标题
  21.     If 正文 <> "" Then Email.Textbody = 正文
  22.     aTypeName = TypeName(附件)  '判断变量类型
  23.     If aTypeName = "String" Then   '传入字符串
  24.         If Dir(附件) <> "" Then  '文件存在
  25.             Email.AddAttachment 附件  '单个附件
  26.         End If
  27.     ElseIf aTypeName = "String()" Then
  28.         For i = LBound(附件) To UBound(附件)  '循环添加多个附件
  29.             If Dir(附件(i)) <> "" Then  '文件存在
  30.                 Email.AddAttachment 附件(i)
  31.             End If
  32.         Next
  33.     End If
  34.     With Email.Configuration.Fields
  35.         .Item(MS_Space & "sendusing") = 2   '发送方式:1代表通过本机SMTP服务发信,2代表通过端口访问远程SMTP服务器发信
  36.         .Item(MS_Space & "smtpserver") = "smtp." & arrID(1)    'SMTP服务器域名或IP,企业邮箱为 mail 前缀
  37.         .Item(MS_Space & "smtpauthenticate") = 1    'SMTP服务器验证密码方式:0代表匿名,1代表基本验证,2代表NTLM方式验证
  38.         If 使用SSL = False Then
  39.             .Item(MS_Space & "smtpserverport") = 25
  40.         Else
  41.             .Item(MS_Space & "smtpserverport") = 465
  42.             .Item(MS_Space & "smtpusessl") = True
  43.         End If
  44.         .Item(MS_Space & "stmpconnectiontimerout") = 60  '设置连接超时,单位秒
  45.         .Item(MS_Space & "sendusername") = 发送方邮箱
  46.         .Item(MS_Space & "sendpassword") = STMP密码
  47. '        当使用本机SMTP服务发信时,需要填写代理地址和端口号
  48. '       .Item(MS_Space & "urlproxyserver") = "61.155.220.244:80"
  49. '       .Item(MS_Space & "urlproxybypass") = ""
  50. '       .Item(MS_Space & "urlgetlatestversion") = True
  51.         .Update
  52.     End With
  53.     Email.Send
  54.     SendMail = (err.Number = 0)
  55.     Debug.Print err.Description
  56.     Set Email = Nothing
  57. End Function
复制代码


评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-12-24 12:54 | 显示全部楼层
本函数不一定通用,但是大部分情况下应该可以使用。
遇到问题先查一下邮箱服务器的调用说明。

TA的精华主题

TA的得分主题

发表于 2016-12-26 17:17 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
虽然也是看不懂,但还是要强烈支持 老朋友 楼主 loquat !
早在 10来年之前,我看过韩-国一个电视剧,就是,也许叫《人鱼公主》或什么,就是在 Word 中写完文字就发送邮件,很羡慕,但是我试了在 Word 中,发不了,让填写服务器名,不会,此项功能不能用,可惜!

TA的精华主题

TA的得分主题

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

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-2-5 15:05 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 loquat 于 2017-2-5 15:06 编辑
413191246se 发表于 2016-12-26 17:17
虽然也是看不懂,但还是要强烈支持 老朋友 楼主 loquat !
早在 10来年之前,我看过韩-国一个电视剧,就是 ...

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

TA的精华主题

TA的得分主题

发表于 2017-2-24 11:55 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
好好学习天天向上

TA的精华主题

TA的得分主题

发表于 2017-3-1 16:19 来自手机 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
很好用,但用代理的那段不知道怎么用。我在单位内网用foxmail在设置帐号后,还要设置用http代理服务器10.32.239.11,端口80,如果在这样的环境下,应该怎么写呢?

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-3-2 12:15 | 显示全部楼层
whatyang 发表于 2017-3-1 16:19
很好用,但用代理的那段不知道怎么用。我在单位内网用foxmail在设置帐号后,还要设置用http代理服务器10.32 ...

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

TA的精华主题

TA的得分主题

发表于 2018-1-4 16:26 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-11-6 20:34 | 显示全部楼层
虽然也是看不懂,但还是要强烈支持 老朋友 楼主 loquat !
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 02:45 , Processed in 0.048837 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表