[2010版WORD群发邮件,添加附件.docxVIP

创建类似下面的excel表格，并且保存创建word邮件—》选择联系人—》使用现有的列表选择第一步中创建的额excel编写邮件内容注意：上面的Title、Name这类的，只需要写入excel中的第一行的名称就可以，不能用“插入合并项”点击“开发工具”选项卡，如下图如果没有该选项卡，按照下面的步骤来做文件—》选项—》自定义功能区，选中“开发工具”，确定，然后就有了“开发工具”选项卡点击“Visual Basic”4.1在弹出的窗口中选择“工具”—》“引用”选择Microsoft Outlook 14.0 Object Library、Microsoft Excel 14.0 Object Library，确定4.2在弹出的窗口中选择“插入”—》“模版”，输入以下代码,关闭Visual Basic窗口Sub sendmail() Dim xlApp As New Excel.Application Dim oOutlookApp As Outlook.Application Dim docSource As Document Dim colCount As Long, rowCount As Long Dim lRecordCount As Long, endColNo As Long Dim bStarted As Boolean Dim oItem As Outlook.MailItem Dim oAccount As Outlook.Account Dim sMySubject As String, sMessage As String, sTitle As String, sMailList As String Dim titles Dim titleString As String Dim titleColumnsCount As Long 将当前文档设置为源文档（主文档） Set docSource = ActiveDocument 获取当前excel工作簿路径 sMailList = docSource.MailMerge.DataSource.Name 检查Outlook是不是打开了。如果未打开的话，就打开新的Outlook On Error Resume Next Set oOutlookApp = GetObject(, Outlook.Application) If Err 0 Then Set oOutlookApp = CreateObject(Outlook.Application) bStarted = True End If 打开保存有客人的邮件地址和需要发送的附件的路径的excel文档。 Dim wb As Excel.Workbook Set wb = xlApp.Workbooks.Open(sMailList) xlApp.Visible = Flase 设置发送邮件的账户（账户必须已经在Outlook中设置好了） Set oAccount = oOutlookApp.Session.Accounts.Item(someone@) 显示一个输入框，询问并让用户输入邮件主题 sMessage = 请为要发送的邮件输入邮件主题。 获取需要发送的邮件数，列数，并将当前节置为第一条记录 lRecordCount = wb.Sheets(Sheet1).Cells(1, 1).CurrentRegion.Rows.Count endColNo = wb.Sheets(Sheet1).Cells(1, 1).CurrentRegion.Columns.Count 获取到表格中表头名称 For titleColumnsCount = 1 To endColNo titleString = titleString + wb.Sheets(Sheet1).Cells(1, titleColumnsCount) + ; Next titleColumnsCount titleString = Left(titleString, Len(titleString) - 1) titles = Split(titleString, ;) docSource.MailMerge.DataSource.ActiveRecord = wdFirstRecord 第一列为表头，需跳过 For rowCount = 2 To lRecordCount Set oItem = oOutlookApp.CreateItem(olMailItem) With oItem .SendUsingAccount = oAccount 设置主题 .Subject = wb.Sheets(Sheet1).Cells(rowCount, 2)