ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

   
EH云课堂-专业的职场技能充电站 限时送,魔方网表将Excel变在线系统 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 高效办公必会的Office实战技巧 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 43786|回复: 101

[分享] 跟我来! 一步一步教你批量发送邮件

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2014-10-13 15:03 | 显示全部楼层 |阅读模式
本帖最后由 闻启学 于 2014-10-13 22:01 编辑

在论坛上有部分网友都求助批量发送邮件,我自己研究一点,特来班门弄斧!不如来个与其授予鱼不如授渔吧! 我自己边玩边学,有错误地方请指正
我不想这么闷 所以 以 小闻 与刘老师对话形式出现


小闻:刘老师,我想批量发送邮件 不知道是否可以 要带附件哦
刘老师:小闻,当然可以,但是要用到outlook VBA 哦

小闻: outlook VBA,Excel VBA 我就会 ,outlook VBA 我无接触过啊, 不知道我自己可以。
刘老师: 你有 Excel VBA 底子,这样会事半功倍的,你要记住 千变万变不离其中, outlook VBA 与 Excel VBA区别 只是对象有所不同,其他语法完全一样的
outlook VBA 对象 无非 是 邮件(MailItem),日历,联系人,约会 ,任务之类的


刘老师:我们现在从最简单开始  新建一个邮件
1 新建第一个邮件

  1. Sub NewMail()
  2.     Dim OutApp As outlook.Application  ‘//定义outlook的对象变量
  3.     Dim oItem As outlook.MailItem    ‘//定义outlook邮件的对象变量
  4.    Set OutApp = New outlook.Application  ‘//创建outlook对象
  5.        Set oItem = OutApp.CreateItem(olMailItem)  ‘//创建一封新的邮件
  6.         With oItem
  7.         .To = "lyhschool@163.com"   ‘//邮件收件人
  8.         .CC = “417149126@qq.com”  ‘//邮件抄送人
  9.         .Subject = "测试图片"’//邮件的主题
  10.         .BodyFormat = olFormatHTML  ‘//设置邮件格式 是否html 格式的
  11.         .Attachments.Add "D:" & myatt  ‘//添加附件
  12.         .Body = “你好发送邮件”   ‘//邮主体内容
  13.         .Display    ‘//新建邮件窗口显示
  14.         .send   ‘//邮件发送   
  15.     End With
  16. End Sub
复制代码


该贴已经同步到 闻启学的微博


评分

参与人数 1鲜花 +1 收起 理由
songzi2000 + 1 优秀作品

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-10-13 15:17 | 显示全部楼层
本帖最后由 闻启学 于 2014-10-13 22:10 编辑

小闻:刘老师, 新建一个邮件我知晓,但是多个邮件呢!!!
刘老师: 小闻,你不会转弯吗? 我来问你,如果在Excel  VBA  中怎样完成一个重复的事情。

小闻: 这个肯定用循环语句啊,还用想吗?那在outlook VBA 可以使用吗!
刘老师:不尝试过就知道不行,代码是测试出来的,不是讲出来的  

2,向同一个人发多个邮件
如果要向同一个邮箱发送多个邮件 怎么办! 可以这样考虑 上面已经知道发送一个邮件的代码 能否再改进一下! Come on
  1. Sub SandMoreMail()
  2.     Dim OutApp As outlook.Application  ‘//定义outlook的对象变量
  3.     Dim oItem As outlook.MailItem    ‘//定义outlook邮件的对象变量
  4.    Set OutApp = New outlook.Application  ‘//创建outlook对象
  5.     For i=1  to  50  ‘//循环体
  6.        Set oItem = OutApp.CreateItem(olMailItem)  ‘//创建一封新的邮件
  7.         With oItem
  8.         .To = "lyhschool@163.com"   ‘//邮件收件人
  9.         .CC = “417149126@qq.com”  ‘//邮件抄送人
  10.         .Subject = “第” & I & “封邮件发送”  ‘//组合邮件的主题内容
  11.         .BodyFormat = olFormatHTML  ‘//设置邮件格式 是否html 格式的
  12.         .Attachments.Add "D:" & myatt  ‘//添加附件
  13.         .Body = “你好!!第” & I & “封邮件发送”   ‘//邮主体内容
  14.         .Display    ‘//新建邮件窗口显示
  15.         .send   ‘//邮件发送   
  16. End With
  17. Next
  18. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2014-10-13 19:30 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-10-13 21:45 | 显示全部楼层
小闻: 老师 如果我要每一封邮件不同收件人和相同附件呢
刘老师: 这个要用一个数据源 来存储这些收件人和邮箱地址 ,用循环获得这样数据 发送邮件  我现在用数组保存数据
  1. Sub hhh()

  2.     Dim arr

  3.     arr = Array(Array("序号", "主题", "主体", "邮箱"), Array(1, "测试邮件", "你好,测试邮件进行中!!!", "lyhschool@163.com"), Array(2, "测试邮件", "你好,测试邮件进行中!!!", "417149126@qq.com"))
  4.     Dim OutApp As Outlook.Application  '//定义outlook的对象变量
  5.     Dim oItem As Outlook.MailItem    '//定义outlook邮件的对象变量
  6.     Set OutApp = New Outlook.Application  '//创建outlook对象
  7.    dim  myatt  as string
  8.    myatt  =“D:\5.jpg”
  9.     For i = 1 To UBound(arr(0)) - 1
  10.         Set oItem = OutApp.CreateItem(olMailItem)  '//创建一封新的邮件
  11.         With oItem
  12.             .To = arr(i)(3)   '//邮件收件人
  13.             '// .CC = "417149126@qq.com"  '//邮件抄送人
  14.             .Subject = arr(i)(1)    '//邮件的主题
  15.             .BodyFormat = olFormatHTML  '//设置邮件格式 是否html 格式的
  16.            '// .Attachments.Add myatt   '//添加附件
  17.             .Body = arr(i)(2)  '//邮主体内容
  18.            '// .Display    '//新建邮件窗口显示
  19.             .Send   '//邮件发送
  20.         End With
  21.     Next

  22. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2014-10-14 08:15 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-10-14 10:03 | 显示全部楼层
本帖最后由 闻启学 于 2014-10-14 10:21 编辑

小闻:老师,我的数据源在Excel 表里 在outlook 怎样获得Excel 表的数据啊
刘老师: 这个是office 的协同问题啊  可以在outlook 绑定Excel的 程序 引用:Microseft Excel*.0 Object Library 或者可以在EXcel绑定 outlook 程序  我的习惯就是这个  

绑定分为 前期绑定 和后期绑定

前期绑定 点击菜单栏 --->工具 -->引用-->对应项目  Microseft Excel*.0 Object Library  or Microseft    outlook *.0 Object Library

后期绑定  使用代码 set xlapp =createobject("Excel.application") '// 引用Excel 程序  
set outlooklapp =createobject("outlook.application") '// 引用outlook程序
  1. '*******************************************************************'

  2. '程序名称:最完美的利用EXCEL自动批量发送邮件

  3. '
  4. '经测试在OUTLOOK 2000中不会显示警告窗口.

  5. '引用:Microseft Outlook *.0 Object Library

  6. '需要注意一点 , 邮件的标题, 否则不能自动放送!

  7. '**********************************************************************

  8. Sub 批量发送邮件()

  9. '要能正确发送并需要对Microseft Outlook进行有效配置

  10.     On Error Resume Next

  11.     Dim rowCount, endRowNo

  12.     '要正常运行下面这句,要将工具/引用中的Microseft Outlook *.0 Object Library(其中*为你Microseft Outlook的版本号)选上

  13.     Dim objOutlook As New Outlook.Application

  14.     Dim objMail As MailItem

  15.     '取得当前工作表与Cells(1,1)相连的数据区行数

  16.     endRowNo = Cells(1, 1).CurrentRegion.Rows.Count

  17.     '创建objOutlook为Outlook应用程序对象

  18.     Set objOutlook = New Outlook.Application

  19.     '开始循环发送电子邮件

  20.     For rowCount = 2 To endRowNo

  21.         '创建objMail为一个邮件对象

  22.         Set objMail = objOutlook.CreateItem(olMailItem)

  23.         With objMail

  24.             '设置收件人地址(从通讯录表的'E-mail地址'字段中获得)

  25.             .To = Cells(rowCount, 1)

  26.             '设置邮件主题

  27.             .Subject = Cells(rowCount, 2)

  28.             '设置邮件内容(从通讯录表的'内容'字段中获得)

  29.             .Body = Cells(rowCount, 3)

  30.             '设置附件(从通讯录表的'附件'字段中获得)

  31.             .Attachments.Add Cells(rowCount, 4)

  32.             '自动发送邮件

  33.             .Send

  34.         End With

  35.         '销毁objMail对象

  36.         Set objMail = Nothing

  37.     Next


  38.     '销毁objOutlook对象
  39.     Set objOutlook = Nothing
  40.     '所有电子邮件发送完成时提示
  41.     MsgBox rowCount - 1 & "个朋友的问候信发送成功!"
  42.     '
  43.     If Application.Workbooks.Count = 1 Then
  44.         Application.Quit
  45.     Else
  46.         Workbooks("自动发送邮件.xls").Close
  47.     End If
  48.     '
  49. End Sub
复制代码
自动发送邮件.zip (16.41 KB, 下载次数: 2101)

评分

参与人数 4财富 +50 鲜花 +7 技术 +1 收起 理由
七夕、 + 3 优秀作品
信天翁107 + 2 优秀作品
带劲儿 + 2 haha good job,thanks for qixue
dsd999 + 50 + 1 优秀作品

查看全部评分

TA的精华主题

TA的得分主题

发表于 2014-10-14 13:10 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2014-10-20 15:53 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2014-10-27 13:45 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2014-10-29 13:40 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

最新热点上一条 /1 下一条

关注官方微信,每天学会一个新技能

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

GMT+8, 2019-4-21 22:34 , Processed in 0.098372 second(s), 13 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 2001-2017 Wooffice Inc.

   

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

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

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