新浪博客

利用office 2016 Word和Outlook 批量发送合并邮件并上传附件

2018-01-05 17:51阅读：

http://blog.sina.cn/dpool/blog/u/2790452001

1.思路：
利用Word已有邮件合并功能，借助VBA实现附件上传。
2.具体步骤：
Step1:新建一个Word文档，用于存放待发客户的姓名、邮箱、附件地址，此处命名为“邮箱附件.docx”,注意，本代码从第三列开始，都为附件地址的属性了，可更具自身需要，在代码中更改。
利用office <wbr>2016 <wbr>Word和Outlook <wbr>批量发送合并邮件并上传附件
Step2：新建一个Word文档，用于存放邮件正文内容
模板，此处命名为“邮件正文.docx”。
利用office <wbr>2016 <wbr>Word和Outlook <wbr>批量发送合并邮件并上传附件
Step3：在Word文档“邮件正文.docx”中选择：
“邮件”à“选择收件人”à“使用现有列表(E)…”,选择“邮箱附件.docx”并点击“打开”à在正文中，将光标移到待放姓名处，点击“插入合并域”à选择“姓名”并插入à点击“预览结果”，此时“«姓名»”会变成对应“邮箱附件.docx”中的姓名。
利用office <wbr>2016 <wbr>Word和Outlook <wbr>批量发送合并邮件并上传附件
利用office <wbr>2016 <wbr>Word和Outlook <wbr>批量发送合并邮件并上传附件
利用office <wbr>2016 <wbr>Word和Outlook <wbr>批量发送合并邮件并上传附件
Step4：确保电脑已经安装outlook，并登录了邮箱账户：
利用office <wbr>2016 <wbr>Word和Outlook <wbr>批量发送合并邮件并上传附件
Step5：回到Step3使用的“邮件正文.docx”，使用快捷键Alt+F11调出VBA控制台:
选中“ThisDocument” à “工具”à “引用”，选择“Microsoft Outlook 16.0 Object Library”引用à双击“ThisDocument”新建一个模块，复制下方代码，并将其中的邮件账户更改为outlook登录帐户。
利用office <wbr>2016 <wbr>Word和Outlook <wbr>批量发送合并邮件并上传附件
利用office <wbr>2016 <wbr>Word和Outlook <wbr>批量发送合并邮件并上传附件 Sub eMailMergeWithAttachments()
Dim docSource As Document, docMaillist As Document
Dim rngDatarange As Range
Dim i As Long, j As Long
Dim lRecordCount 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@examplemail.com')语句删除
Set oAccount = oOutlookApp.Session.Accounts.Item('xllo@outlook.com')
'显示一个输入框，询问并让用户输入邮件主题
sMessage = '请为要发送的邮件输入邮件主题。'
sTitle = '输入邮件主题'
sMySubject = InputBox(sMessage, sTitle)
'循环查找源文档中所有的节（每一节为一封邮件内容），以及循环查找邮件列表文档中所有的客户信息，
'以便用于插入到生成的邮件中
'获取需要发送的邮件数，并将当前节置为第一条记录
lRecordCount = docMaillist.Tables(1).Rows.Count
docSource.MailMerge.DataSource.ActiveRecord = wdFirstRecord
'第一列为表头，需跳过
For j = 2 To lRecordCount
Set oItem = oOutlookApp.CreateItem(olMailItem)
With oItem
'注意：如果你的Outlook版本低于2007，使用设置发送邮件的账户可能会导致错误，
'建议将下面的.SendUsingAccount = oAccount语句删除
.SendUsingAccount = oAccount
.Subject = sMySubject
'正文内容，节号1的文字
.Body = docSource.Sections(1).Range.Text
'邮箱地址在第2列
Set rngDatarange = docMaillist.Tables(1).Cell(j, 2).Range
rngDatarange.End = rngDatarange.End - 1
.To = rngDatarange
'在下面设置附件开始列i
For i = 3 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), olByValue, 1
Next i
.Send
End With
Set oItem = Nothing
'Word邮件文档下一节
docSource.MailMerge.DataSource.ActiveRecord = wdNextRecord
Next j
docMaillist.Close wdDoNotSaveChanges
'如果Outlook是由该宏打开的，则关闭Outlook
If bStarted Then
oOutlookApp.Quit
End If
MsgBox '共发送了 ' & lRecordCount - 1 & ' 封邮件。'
'清空Outlook实例
Set oOutlookApp = Nothing
End Sub
Step6：运行代码，当跳出文件选择框时，选择“邮箱附件.docx”，接着输入邮件主题，就大功告成啦！
利用office <wbr>2016 <wbr>Word和Outlook <wbr>批量发送合并邮件并上传附件
利用office <wbr>2016 <wbr>Word和Outlook <wbr>批量发送合并邮件并上传附件

我的更多文章

下载客户端阅读体验更佳

APP专享