用WORD群发邮件

【Word 合并邮件】功能无法直接发送带有附件的个性化群邮件，需要做一些修改。

以下内容是根据网络上提供的方案，我用word 2007测试后能用的方法：
准备工作：
首先用Word建立一个“目录”类型的邮件合并，在主文档中插入一个只有一行的表格，列数根据需要设置，但在我们现在的这个文档中，至少需要两列，第一列存放客人邮箱地址的合并域，第二列存放附件的完整路径的合并域，包括附件的名称与后缀。

如果你需要添加多于一个附件，就增加第三列，并把新的附件的路径的合并域放进去。

完成以后，实行邮件合并，生成一个包含了所有客人邮箱地址和需要发送给每个客人的附件的路径的Word文档（我是直接手敲的，不大清楚怎么整附件的合并域）。

为该文档建一个你喜欢的名字，并保存在电脑上。

这样子，准备工作完成了。

合并前的列表主文档↓
合并后的列表文档↓
建立宏并完成邮件发送：
运行本文所介绍的宏，需要电脑中安装有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这个版本号给华丽的忽略掉了……）。

（这个是outlook，别看错了，我刚开始就是看错了，调试没通过）
然后，插入一个模块，并把下面的代码复制进去：
Sub eMailMergeWithAttachments()
Dim docSource As Document, docMaillist As Document, docTempDoc As Document
Dim rngDatarange As Range
Dim i As Long, j As Long
Dim lSectionsCount As Long
Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
Dim oAccount As Outlook.Account
Dim sMySubject As String, sMessage As String, sTitle As String
'将当前文档设置为源文档（主文档）
Set docSource = ActiveDocument
'检查Outlook是不是打开了。

如果未打开的话，就打开新的Outlook
On Error Resume Next
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
bStarted = True
End If
'打开保存有客人的邮件地址和需要发送的附件的路径的word文档。

With Dialogs(wdDialogFileOpen)
.Show
End With
'将该文档设置为客户邮件（附件）列表文档
Set docMaillist = ActiveDocument
'设置发送邮件的账户（账户必须已经在Outlook中设置好了）
'注意：如果你的Outlook版本低于2007，使用设置发送邮件的账户可能会导致错误，'建议将下面的Set oAccount = oOutlookApp.Session.Accounts.Item("someone@")语句删除Set oAccount = oOutlookApp.Session.Accounts.Item("someone@")
'显示一个输入框，询问并让用户输入邮件主题
sMessage = "请为要发送的邮件输入邮件主题。

"
sTitle = "输入邮件主题"
sMySubject = InputBox(sMessage, sTitle)
'循环查找源文档中所有的节（每一节为一封邮件内容），以及循环查找邮件列表文档中所有的客户信息，
'以便用于插入到生成的邮件中
lSectionsCount = docSource.Sections.Count - 1
'当源文档中的节数仅有1时，lSectionsCount=0，将导致程序无法正常运行。

'为了保证当源文档只有1节时程序能正常运行，必须使lSectionsCount至少等于1
If lSectionsCount = 0 Then lSectionsCount = 1
For j = 1 To lSectionsCount
Set oItem = oOutlookApp.CreateItem(olMailItem)
With oItem
'注意：如果你的Outlook版本低于2007，使用设置发送邮件的账户可能会导致错误，
'建议将下面的.SendUsingAccount = oAccount语句删除
.SendUsingAccount = oAccount
.Subject = sMySubject
.Body = docSource.Sections(j).Range.Text
Set rngDatarange = docMaillist.Tables(1).Cell(j, 1).Range
rngDatarange.End = rngDatarange.End - 1
.To = rngDatarange
For i = 2 To docMaillist.Tables(1).Columns.Count
Set rngDatarange = docMaillist.Tables(1).Cell(j, i).Range
rngDatarange.End = rngDatarange.End - 1
.Attachments.Add Trim(rngDatarange.Text), olByV alue, 1
Next i
.Send
End With
Set oItem = Nothing
Next j
docMaillist.Close wdDoNotSaveChanges
'如果Outlook是由该宏打开的，则关闭Outlook
If bStarted Then
oOutlookApp.Quit
End If
MsgBox "共发送了" & lSectionsCount & "封邮件。

"
'清空Outlook实例
Set oOutlookApp = Nothing
End Sub
到这里，基本上已经完成大部分的工作了。

（代码中，那两句编程我都没删掉，只是将someone@ 修改为我自己的email地址）
现在，实行邮件合并，生成包含需要发给所有客人的邮件的Word文档。

然后运行刚刚完成的宏，就可以了。

有一点需要特别注意的是：用于生成客人邮箱地址和附件列表的邮件合并的数据源，和用于生成邮件本身的邮件合并的数据源，最好是相同的，否则有可能导致把错误的附件发送给错误的客人的情况。

合并前的邮件主文档↓
合并后的邮件文档↓
* 为了方便测试，一开始的数据源的数据不要太多，可以只有2、3个记录，然后把发送邮件的代码“.Send”给成“.Display”，这样子邮件不会马上发送出去，而是会打开邮件。

这样子可以检查一下程序是否运行正确。

* 程序在Office 2010中测试通过
在Outlook 2007中，会出来安全警告，每封信都有，如果不提前做设置，就需要每封都点击允许，我就点了几百下，累死。

这个可以在outlook信任中心（工具\信任中心\编程访问）中选择从不向我发出可疑警告。