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

闻启学

在论坛上有部分网友都求助批量发送邮件，我自己研究一点，特来班门弄斧！不如来个与其授予鱼不如授渔吧！ 我自己边玩边学，有错误地方请指正

这里 以 小闻 与刘老师对话形式出现

小闻：刘老师，我想批量发送邮件 不知道是否可以 要带附件哦刘老师：小闻，当然可以，但是要用到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 = "l"   ‘//邮件收件人 自己填入自己邮箱
   
8.         .CC = “”  ‘//邮件抄送人 自己填入自己邮箱
   
9.         .Subject = "测试图片"’//邮件的主题
   
10.         .BodyFormat = olFormatHTML  ‘//设置邮件格式 是否html 格式的
    
11.         .Attachments.Add "D:" & myatt  ‘//添加附件
    
12.         .Body = “你好发送邮件”   ‘//邮主体内容
    
13.         .Display    ‘//新建邮件窗口显示
    
14.         .send   ‘//邮件发送   
    
15.     End With
    
16. End Sub
    

复制代码

闻启学

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

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

2，向同一个人发多个邮件
如果要向同一个邮箱发送多个邮件 怎么办！ 可以这样考虑 上面已经知道发送一个邮件的代码 能否再改进一下！ Come on body

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 = "l"   ‘//邮件收件人 自己写入邮箱
   
9.         .CC = “”  ‘//邮件抄送人自己写入邮箱
   
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
    

复制代码

闻启学

小闻： 老师 如果我要每一封邮件不同收件人和相同附件呢
刘老师： 这个要用一个数据源 来存储这些收件人和邮箱地址 ，用循环获得这样数据 发送邮件  我现在用数组保存数据

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
    

复制代码

闻启学

小闻：老师，我的数据源在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. '
   
5. '经测试在OUTLOOK 2000中不会显示警告窗口.
   
6. 
   
7. '引用：Microseft Outlook *.0 Object Library
   
8. 
   
9. '需要注意一点 , 邮件的标题, 否则不能自动放送!
   
10. 
    
11. '**********************************************************************
    
12. 
    
13. Sub 批量发送邮件()
    
14. 
    
15. '要能正确发送并需要对Microseft Outlook进行有效配置
    
16. 
    
17.     On Error Resume Next
    
18.     Dim rowCount, endRowNo
    
19.     '要正常运行下面这句,要将工具/引用中的Microseft Outlook *.0 Object Library(其中*为你Microseft Outlook的版本号)选上
    
20.     Dim objOutlook As New Outlook.Application
    
21.     Dim objMail As MailItem
    
22.     '取得当前工作表与Cells(1,1)相连的数据区行数
    
23.     endRowNo = Cells(1, 1).CurrentRegion.Rows.Count
    
24.     '创建objOutlook为Outlook应用程序对象
    
25.     Set objOutlook = New Outlook.Application
    
26.     '开始循环发送电子邮件
    
27.     For rowCount = 2 To endRowNo
    
28.         '创建objMail为一个邮件对象
    
29.         Set objMail = objOutlook.CreateItem(olMailItem)
    
30.         With objMail
    
31.             '设置收件人地址（从通讯录表的'E-mail地址'字段中获得）
    
32.             .To = Cells(rowCount, 1)
    
33.             '设置邮件主题
    
34.             .Subject = Cells(rowCount, 2)
    
35.             '设置邮件内容（从通讯录表的'内容'字段中获得）
    
36.             .Body = Cells(rowCount, 3)
    
37.             '设置附件（从通讯录表的'附件'字段中获得）
    
38.             .Attachments.Add Cells(rowCount, 4).value
    
39.             '自动发送邮件
    
40.             .Send
    
41.         End With
    
42.         '销毁objMail对象
    
43.         Set objMail = Nothing
    
44.     Next
    
45.     '销毁objOutlook对象
    
46.     Set objOutlook = Nothing
    
47.     '所有电子邮件发送完成时提示
    
48.     MsgBox rowCount - 1 & "个朋友的问候信发送成功！"
    
49.     '
    
50.     If Application.Workbooks.Count = 1 Then
    
51.         Application.Quit
    
52.     Else
    
53.         Workbooks("自动发送邮件.xls").Close
    
54.     End If
    
55.     '
    
56. End Sub
    

复制代码

闻启学

一对多的 邮件

这种邮件 一般用在对部门经理汇报员工情况之类的
分析下 其实这个是简单的 拆分工作表的 只不过拆分后 放在邮件中  

1，数据重组
   按某个关键字拆分工作表 ，利用字典去重
2，邮件
   邮件正文
  循环数组，获得对应字典健的数组
   遍历数组中的数据，用字符组合成Html格式文本
  根据关键字获得邮件地址和收件人的名字

tmtony

赞一个，不错哦。
之前不是转VSTO，又转回VBA了？