ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
一招顶“一万招”的懒人技巧 Excel 2016函数公式学习大典 Office知识技巧免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 82972|回复: 132

[原创] 在邮件合并中添加附件

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2010-11-16 12:04 | 显示全部楼层 |阅读模式
本文主要介绍如何通过宏(vba)在邮件合并中添加附件。关于邮件合并的基本使用方法,将不进行介绍。
        Word的邮件合并是一个很强大、很实用的功能,但是美中不足的是,无法在邮件合并中添加附件,并把附件作为邮件的一部分发送出去(虽然可以通过把整个文档包括附件作为邮件的附件发送出去,但是这样子并不完美解决问题)。为了实现这样的功能,需要借助到宏的帮助。

准备工作:
        首先用Word建立一个“目录”类型的邮件合并,在主文档中插入一个只有一行的表格,列数根据需要设置,但在我们现在的这个文档中,至少需要两列,第一列存放客人邮箱地址的合并域,第二列存放附件的完整路径的合并域,包括附件的名称与后缀。如果你需要添加多于一个附件,就增加第三列,并把新的附件的路径的合并域放进去。完成以后,实行邮件合并,生成一个包含了所有客人邮箱地址和需要发送给每个客人的附件的路径的Word文档。为该文档建一个你喜欢的名字,并保存在电脑上。这样子,准备工作完成了。
        合并前的邮件列表主文档:
        合并前列表.jpg
        合并后的邮件列表:
        合并后列表.jpg
建立宏并完成邮件发送:
        运行本文所介绍的宏,需要电脑中安装有Outlook(建议安装Outlook 2007或者以上版本)。在开始写宏程序之前,需要在vba编辑器中添加对Outlook的引用。具体步骤是:在需要建立邮件合并的Word主文档中按Alt+F11打开vba编辑器,然后在“工具”菜单中选择“引用”,并添加类似于“Microsoft Outlook ##.0 Object Library”的引用,其中“##”是Outlook的版本号(如果我没有记错的话,2003是11.0,2007是12.0,2010是14.0——好像微软觉得13.0不吉利,把13这个版本号给华丽的忽略掉了……)。
        然后,插入一个模块,并把下面的代码复制进去:
  1. Sub eMailMergeWithAttachments()

  2.     Dim docSource As Document, docMaillist As Document, docTempDoc As Document

  3.     Dim rngDatarange As Range

  4.     Dim i As Long, j As Long

  5.     Dim lSectionsCount As Long

  6.     Dim bStarted As Boolean

  7.     Dim oOutlookApp As Outlook.Application

  8.     Dim oItem As Outlook.MailItem

  9.     Dim oAccount As Outlook.Account

  10.     Dim sMySubject As String, sMessage As String, sTitle As String

  11.     '将当前文档设置为源文档(主文档)

  12.     Set docSource = ActiveDocument

  13.     '检查Outlook是不是打开了。如果未打开的话,就打开新的Outlook

  14.     On Error Resume Next

  15.     Set oOutlookApp = GetObject(, "Outlook.Application")

  16.     If Err <> 0 Then

  17.         Set oOutlookApp = CreateObject("Outlook.Application")

  18.         bStarted = True

  19.     End If

  20.     '打开保存有客人的邮件地址和需要发送的附件的路径的word文档。

  21.     With Dialogs(wdDialogFileOpen)

  22.         .Show

  23.     End With

  24.     '将该文档设置为客户邮件(附件)列表文档

  25.     Set docMaillist = ActiveDocument

  26.     '设置发送邮件的账户(账户必须已经在Outlook中设置好了)

  27.     '注意:如果你的Outlook版本低于2007,使用设置发送邮件的账户可能会导致错误,

  28.     '建议将下面的Set oAccount = oOutlookApp.Session.Accounts.Item("someone@examplemail.com")语句删除

  29.     Set oAccount = oOutlookApp.Session.Accounts.Item("someone@examplemail.com")

  30.     '显示一个输入框,询问并让用户输入邮件主题

  31.     sMessage = "请为要发送的邮件输入邮件主题。"

  32.     sTitle = "输入邮件主题"

  33.     sMySubject = InputBox(sMessage, sTitle)

  34.     '循环查找源文档中所有的节(每一节为一封邮件内容),以及循环查找邮件列表文档中所有的客户信息,

  35.     '以便用于插入到生成的邮件中

  36.     lSectionsCount = docSource.Sections.Count - 1

  37.     '当源文档中的节数仅有1时,lSectionsCount=0,将导致程序无法正常运行。

  38.     '为了保证当源文档只有1节时程序能正常运行,必须使lSectionsCount至少等于1

  39.     If lSectionsCount = 0 Then lSectionsCount = 1

  40.     For j = 1 To lSectionsCount

  41.         Set oItem = oOutlookApp.CreateItem(olMailItem)

  42.         With oItem

  43.             '注意:如果你的Outlook版本低于2007,使用设置发送邮件的账户可能会导致错误,

  44.             '建议将下面的.SendUsingAccount = oAccount语句删除

  45.             .SendUsingAccount = oAccount

  46.             .Subject = sMySubject

  47.             .Body = docSource.Sections(j).Range.Text

  48.             Set rngDatarange = docMaillist.Tables(1).Cell(j, 1).Range

  49.             rngDatarange.End = rngDatarange.End - 1

  50.             .To = rngDatarange

  51.             For i = 2 To docMaillist.Tables(1).Columns.Count

  52.                 Set rngDatarange = docMaillist.Tables(1).Cell(j, i).Range

  53.                 rngDatarange.End = rngDatarange.End - 1

  54.                 .Attachments.Add Trim(rngDatarange.Text), olByValue, 1

  55.             Next i

  56.             .Send

  57.         End With

  58.         Set oItem = Nothing

  59.     Next j

  60.     docMaillist.Close wdDoNotSaveChanges

  61.     '如果Outlook是由该宏打开的,则关闭Outlook

  62.     If bStarted Then

  63.         oOutlookApp.Quit

  64.     End If

  65.     MsgBox "共发送了 " & lSectionsCount & " 封邮件。"

  66.     '清空Outlook实例

  67.     Set oOutlookApp = Nothing

  68. End Sub
复制代码
到这里,基本上已经完成大部分的工作了。
&#160; &#160; &#160; &#160; 现在,实行邮件合并,生成包含需要发给所有客人的邮件的Word文档。然后运行刚刚完成的宏,就可以了。
&#160; &#160; &#160; &#160; 有一点需要特别注意的是:用于生成客人邮箱地址和附件列表的邮件合并的数据源,和用于生成邮件本身的邮件合并的数据源,最好是相同的,否则有可能导致把错误的附件发送给错误的客人的情况。
&#160; &#160; &#160; &#160; 合并前的邮件主文档:
&#160; &#160; &#160; &#160; 合并前主文档.jpg
&#160; &#160; &#160; &#160; 合并后的邮件文档:
&#160; &#160; &#160; &#160; 合并后文档.jpg

* 为了方便测试,一开始的数据源的数据不要太多,可以只有2、3个记录,然后把发送邮件的代码“.Send”给成“.Display”,这样子邮件不会马上发送出去,而是会打开邮件。这样子可以检查一下程序是否运行正确。
* 程序在Office 2010中测试通过
* 本文参考了以下网站,并根据我自己的实际情况用运行中发现的问题,对代码做了部分修改。
http://word.mvps.org/faqs/mailmerge/MergeWithAttachments.htm

[ 本帖最后由 siliconxu 于 2010-11-16 12:36 编辑 ]

补充内容 (2017-4-4 11:25):
补充一点。有很多朋友发现发送邮件的时候,只能发送1封邮件。有这个情况的朋友,请在合并邮件内容的模板文档里面,添加一个“节符号”。

补充内容 (2017-4-4 11:28):
就是在模板内容的最后面,添加一个“分节符”。一般可以在菜单的“布局” - “分隔符” - “分节符”里面。

补充内容 (2017-4-24 09:46):
99楼增加了对抄送和密抄的支持,并上传了附件。大家可以参考一下。

评分

参与人数 1鲜花 +1 收起 理由
仰望兴叹 + 1 太强大了

查看全部评分

TA的精华主题

TA的得分主题

发表于 2010-12-13 15:16 | 显示全部楼层

这么经典和实用的帖子,怎么会没人回呢?

我研究研究,看能不能解决啊,微软为啥不解决这个问题呢,2010好像都还不能带附件

TA的精华主题

TA的得分主题

 楼主| 发表于 2010-12-13 23:10 | 显示全部楼层
回楼上。有问题直接回帖,一起探讨~~

TA的精华主题

TA的得分主题

发表于 2010-12-14 07:47 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2011-1-6 09:43 | 显示全部楼层
如果能把存放邮件和附件列表的WORD文档变为EXCEL文档,那就更好了。

TA的精华主题

TA的得分主题

 楼主| 发表于 2011-1-7 13:05 | 显示全部楼层
这里讨论的是使用word的邮件合并功能。使用excel的话,其实基本上方法是一样的。对原来word文档里面的vba做一些修改应该就可以了。LS可以试一下的   (不过excel在批量生产邮件内容、列表方面可能没有word的邮件合并来得容易)

TA的精华主题

TA的得分主题

发表于 2011-1-21 15:09 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2011-1-28 18:03 | 显示全部楼层
很厉害,但现在已经熟悉了Excel发邮件~感觉word还是有点不方便~>_<~

TA的精华主题

TA的得分主题

发表于 2011-2-12 13:58 | 显示全部楼层
目前这个VBA程序发邮件是用TEXT文本方式发的,如果能用HTML格式发邮件那就更好了。

TA的精华主题

TA的得分主题

发表于 2011-2-12 14:28 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

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

GMT+8, 2021-9-20 00:09 , Processed in 0.083916 second(s), 12 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2021 Wooffice Inc.

   

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

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

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