word中如何使用宏将邮件合并内容逐条生成

1.在菜单栏----邮件菜单----开始邮件合并----邮件合并分步向导，在文档的左边出现“邮件合并”对话栏。

2.选择文档类型为“信函”（将信函发送给一组人，可以设置信函的格式），单击“下一步”继续。

3.点击下一步（正在启动文档）---选择开始文档，就是需要设置信函，选中“使用当前文档”，单击“下一步”

4.点击下一步（选取收件人）---选择收件人，勾中“使用现在列表”，点击“浏览...”（使用来自某文件或数据库的姓名和地址。），选择数据源，找到需要添加的数据源地址---选择表格，的名称SHEET1$,和选中数据首行包含列标题。并点击确定按钮，---选择“邮件合并收件人”把需要的收件人列表勾中，在此不可以调整收件人列表，比如：排序，筛选，查找重复收件人，查找收件人，验证地址---点击确定。

5.回到“邮件合并”栏，选择下一步：撰写信函，选中“其他项目”---出现“插入合并域”，根据需要合并的邮件内容，选择域的内容。比如:姓名栏后面添加姓名域，性别栏添加性别域等等。插入完后，点击关闭。单击“下一步”预览信函---可以就看到第一条记录。

6.点击“下一步”完成邮件合并---完成合并，已经可以使用“邮件合并”生成信函----点击“编辑单个信函”---选择合并全部记录。左边可以看到，记录的全部内容。此时就可以打印，需要的内容。

7.邮件合并完成。注：如果要修改，就可以点击“上一步”来实现修改，其他 *** 作和上述相同。

你好

​通过调用 word的宏倒可以曲线实现这样的功能

胡乱凑出来的代码 不过调试以已经通过 分享给大家 ，不要贻笑大方哦

Public wdApp As Word.Application

Public wdAppTem As Word.Application

Public Mail_Doc As String

Public Mail_Text

Public Mail_Counter As Integer

Public ReportDate_Temp As Date

Public Sent_Date As String

Public Sent_Date_Temp As String

Public Report_Flag As String

Public Report_Subject As String

Public Sub Open_Word_OutLook()

.......

Work_Path = ThisWorkbook.Path

Mail_Doc = Work_Path &"\" &"Mailok.doc"

Set wdApp = New Word.Application

With wdApp

.Documents.Open Filename:=Mail_Doc

.Visible = True

.ActiveWindow.EnvelopeVisible = False

End With

'打开word 编辑word

wdApp.Selection.WholeStory

wdApp.Selection.Delete

'#####################################################################################

For Mail_Counter = 1 To 18

Mail_Text = ThisWorkbook.Sheets("Mail").Range("A" &Mail_Counter).Value

With wdApp

.Documents.Open Filename:=Mail_Doc

.Visible = True

With .Selection

.EndKey unit:=wdStory

.Text = Mail_Text

.EndKey unit:=wdLine

.TypeParagraph

End With

End With

Next Mail_Counter

'Finish Item 1 to 5

'#####################################################################################

Sheets("Report").Select

ThisWorkbook.Sheets("Report").Range(Cells(39, 1), Cells(51, 6)).Select

Application.CutCopyMode = False

Selection.Copy

ActiveSheet.Pictures.Paste.Select

Application.CutCopyMode = False

Selection.Cut

With wdApp

With .Selection

.EndKey unit:=wdStory

.Paste

.EndKey unit:=wdLine

.TypeParagraph

.TypeParagraph

End With

End With

'Finish Paste Equipment Status PIC

'#####################################################################################

Sheets("Mail").Select

Mail_Text = ThisWorkbook.Sheets("Mail").Range("A19").Value

With wdApp

With .Selection

.EndKey unit:=wdStory

.Text = Mail_Text

.EndKey unit:=wdLine

.TypeParagraph

.TypeParagraph

End With

End With

'Finish paste "ATE down Time &HST Availability"

Sheets("Report").Select

ThisWorkbook.Sheets("Report").Range(Cells(15, 1), Cells(21, 4)).Select

Application.CutCopyMode = False

Selection.Copy

ActiveSheet.Pictures.Paste.Select

Application.CutCopyMode = False

Selection.Cut

With wdApp

With .Selection

.EndKey unit:=wdStory

.Paste

.EndKey unit:=wdLine

.TypeParagraph

.TypeParagraph

End With

End With

'Finish Paste ATE down Time &HST Availability PIC

...........

...........

...........

Sheets("Mail").Select

ActiveSheet.Shapes("Picture 1").Select

Application.CutCopyMode = False

Selection.Copy

With wdApp

With .Selection

.EndKey unit:=wdStory

.Paste

.EndKey unit:=wdLine

End With

End With

'#####################################################################################

With wdApp

.ActiveDocument.Save

End With

'编辑word 结束

wdApp.Run "Create_Mail"

'调用word 宏 将正文创建邮件 至于标题收件人之类在word vba 中完成

AppActivate "Microsoft word"

Do Until wdApp.ActiveWindow.EnvelopeVisible = False

On Error GoTo 1

Loop

With wdApp

' .ActiveDocument.Close

.Quit

End With

Set wdApp = Nothing

GoTo 3

1: Set wdApp = Nothing

GoTo 2

2: MsgBox "You have not sent the mail!!!" &Chr(10) &"The Word Appliction have not close correctly!!!"

3: Sheets("Report").Select

End Sub

---