word文档按节拆分成单独文档

dogingate

Sub DividingBySection()
Dim asection As Section
Dim folderPath As String
Dim fileName As String
Dim sectionCount As Integer
Dim k As Integer

Set doc = ActiveDocument
folderPath = ActiveDocument.Path

sectionCount = doc.Sections.Count

For k = 1 To sectionCount - 1

    Set asection = doc.Sections(k)
    asection.Range.Select
    Selection.Copy
    Set newdoc = Documents.Add
    newdoc.Content.Paste

    ys = k Mod 2
    If ys <> 0 Then
        fileName = Trim(asection.Range.Paragraphs(1).Range)
        fileName = Left(fileName, Len(fileName) - 1)
    Else
        fileName = fileName & "桥梁资料卡"
    End If

    newdoc.SaveAs folderPath & "\" & fileName & ".docx"

    newdoc.Close True

Next k
End Sub

dogingate

没有例子就是耍流氓，所以增添了示例，详见附件
里面是两种拆分方式

1、按节进行拆分

2、按标题2进行拆分

dogingate

这是最新版本，已经试用多次，正常，唯一的问题就是：
1、首先要将文档要拆分的标题刷成word中的“标题 1”、“标题 2”’、“标题 3”这种样式，然后在代码中进行修改，默认是“标题 2”，也就是para.Style =
2、在选择要拆分的文档的时候可以多选，也可以单选，允许多选的话把.AllowMultiSelect = False改为True
3、在保存拆分文档的时候，有的时候要手动保存文档，这当然和你的文档有关系，还有你的标题名（比如标题名含有“#“的时候），提示是否使用正文样式的时候，请选择否，这样可以保留源格式，因为有的文档里的样式不是模板里有的
正常情况下，是只需要干预第一步的，选择文档后文档就会自动拆分完成并提示“拆分完成”
enjoy