跟我来！一步一步教你批量发送邮件

闻启学 · 发表于 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 新建第一个邮件

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

复制代码

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

闻启学 · 发表于 2014-10-13 15:17

本帖最后由闻启学于 2014-10-13 22:10 编辑

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

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

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

Sub SandMoreMail()
Dim OutApp As outlook.Application ‘//定义outlook的对象变量
Dim oItem As outlook.MailItem ‘//定义outlook邮件的对象变量
Set OutApp = New outlook.Application ‘//创建outlook对象
For i=1 to 50 ‘//循环体
Set oItem = OutApp.CreateItem(olMailItem) ‘//创建一封新的邮件
With oItem
.To = "lyhschool@163.com" ‘//邮件收件人
.CC = “417149126@qq.com” ‘//邮件抄送人
.Subject = “第” & I & “封邮件发送” ‘//组合邮件的主题内容
.BodyFormat = olFormatHTML ‘//设置邮件格式是否html 格式的
.Attachments.Add "D:" & myatt ‘//添加附件
.Body = “你好！！第” & I & “封邮件发送” ‘//邮主体内容
.Display ‘//新建邮件窗口显示
.send ‘//邮件发送
End With
Next
End Sub

复制代码

dajiahaoxinku12 · 发表于 2014-10-13 19:30

感谢闻学委分享，来坐板凳静听。

闻启学 · 发表于 2014-10-13 21:45

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

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

复制代码

shaanxi348 · 发表于 2014-10-14 08:15

感谢分享，顶顶

闻启学 · 发表于 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程序

'*******************************************************************'
'程序名称：最完美的利用EXCEL自动批量发送邮件
'
'经测试在OUTLOOK 2000中不会显示警告窗口.
'引用：Microseft Outlook *.0 Object Library
'需要注意一点 , 邮件的标题, 否则不能自动放送!
'**********************************************************************
Sub 批量发送邮件()
'要能正确发送并需要对Microseft Outlook进行有效配置
On Error Resume Next
Dim rowCount, endRowNo
'要正常运行下面这句,要将工具/引用中的Microseft Outlook *.0 Object Library(其中*为你Microseft Outlook的版本号)选上
Dim objOutlook As New Outlook.Application
Dim objMail As MailItem
'取得当前工作表与Cells(1,1)相连的数据区行数
endRowNo = Cells(1, 1).CurrentRegion.Rows.Count
'创建objOutlook为Outlook应用程序对象
Set objOutlook = New Outlook.Application
'开始循环发送电子邮件
For rowCount = 2 To endRowNo
'创建objMail为一个邮件对象
Set objMail = objOutlook.CreateItem(olMailItem)
With objMail
'设置收件人地址（从通讯录表的'E-mail地址'字段中获得）
.To = Cells(rowCount, 1)
'设置邮件主题
.Subject = Cells(rowCount, 2)
'设置邮件内容（从通讯录表的'内容'字段中获得）
.Body = Cells(rowCount, 3)
'设置附件（从通讯录表的'附件'字段中获得）
.Attachments.Add Cells(rowCount, 4)
'自动发送邮件
.Send
End With
'销毁objMail对象
Set objMail = Nothing
Next
'销毁objOutlook对象
Set objOutlook = Nothing
'所有电子邮件发送完成时提示
MsgBox rowCount - 1 & "个朋友的问候信发送成功！"
'
If Application.Workbooks.Count = 1 Then
Application.Quit
Else
Workbooks("自动发送邮件.xls").Close
End If
'
End Sub

复制代码

自动发送邮件.zip (16.41 KB, 下载次数: 3287)

Terrorblade · 发表于 2014-10-14 13:10

很强大感谢分享学习

NealMi · 发表于 2014-10-20 15:53

学习了，很不错！

1583478094 · 发表于 2014-10-27 13:45

非常好，学习了谢谢了！

onlycxb · 发表于 2014-10-29 13:40

不错，顶一下

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

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

评分

评分

最新热点 /1

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

评分

评分

最新热点 /1

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