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

引用 闻启学 2019-4-14 11:07

本帖最后由 闻启学 于 2019-4-14 11:20 编辑

小闻：刘老师， 新建一个邮件我知晓，但是多个邮件呢！！！
刘老师： 小闻，你不会转弯吗？ 我来问你，如果在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
    

复制代码

引用 闻启学 2019-4-14 11:11

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

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
    

复制代码

引用 闻启学 2019-4-14 11:13

小闻：老师，我的数据源在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
    

复制代码

引用 闻启学 2019-4-14 11:18

一对多的 邮件

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

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

QQ截图20190413102013.png (143.13 KB, 下载次数: 0)

下载附件  保存到相册

2019-4-14 11:17 上传

引用 tmtony 2019-4-15 12:46

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

查看全部评论(5)