WORD邮件合并文档自动拆分每节为一个文档

WORD邮件合并文档自动拆分每节为一个文档

Sub 自动拆分每节为一个文档()

   Dim mySec As Section, i As Long, myDoc As Document, SourceDoc As Document                             '定义变量

   Set SourceDoc = ActiveDocument                                                                        '设置源文档为当前活动文档

   For Each mySec In SourceDoc.Sections                                                                 '设置当前文档每节循环

      If mySec.PageSetup.SectionStart = wdSectionNewPage And mySec.Index > 1 Then

         Set myDoc = Application.Documents.Add

         myDoc.Content.FormattedText = SourceDoc.Range(i, mySec.Range.Start - 1)

         myDoc.Content.Sections.Last.PageSetup.SectionStart = _

                  SourceDoc.Range(i, mySec.Range.Start - 1).Sections.Last.PageSetup.SectionStart

         i = mySec.Range.Start

      End If

      

      If mySec.Index = SourceDoc.Sections.Count Then                                                    '最后一节的处理

         Set myDoc = Application.Documents.Add

         myDoc.Content.FormattedText = SourceDoc.Range(i, SourceDoc.Content.End)

         myDoc.Content.Sections.Last.PageSetup.SectionStart = _

                  SourceDoc.Range(i, SourceDoc.Content.End).Sections.Last.PageSetup.SectionStart

      End If

   

   Next

End Sub