将Word按照固定页数拆分成多个文件

本方法主要采用VBA宏脚本进行Word拆分，操作步骤如下：

1、打开需要拆分的Word文件

2、使用快捷组合键“Alt + F11”打开VBA编辑器。

3、双击VBA编辑器左侧“工程”里的“ThisDocument”，打开编辑器，粘贴如下代码：

Option Explicit

Sub SplitEveryFivePagesAsDocuments()
Dim oSrcDoc As Document, oNewDoc As Document
Dim strSrcName As String, strNewName As String
Dim oRange As Range
Dim nIndex As Integer, nSubIndex As Integer, nTotalPages As Integer, nBound As Integer
Dim fso As Object

Const nSteps = 2 ' 修改这里控制每隔几页分割一次

Set fso = CreateObject("Scripting.FileSystemObject")
Set oSrcDoc = ActiveDocument
Set oRange = oSrcDoc.Content

nTotalPages = ActiveDocument.Content.Information(wdNumberOfPagesInDocument)
oRange.Collapse wdCollapseStart
oRange.Select

For nIndex = 1 To nTotalPages Step nSteps
Set oNewDoc = Documents.Add
If nIndex + nSteps > nTotalPages Then
nBound = nTotalPages
Else
nBound = nIndex + nSteps - 1
End If

For nSubIndex = nIndex To nBound
oSrcDoc.Activate
oSrcDoc.Bookmarks("\page").Range.Copy
oSrcDoc.Windows(1).Activate
Application.Browser.Target = wdBrowsePage
Application.Browser.Next
oNewDoc.Activate
oNewDoc.Windows(1).Selection.Paste
Next nSubIndex

oNewDoc.Windows(1).Document.Paragraphs.Last.Range.Select
If Len(Selection) = 1 Then Selection.Delete

strSrcName = oSrcDoc.FullName
strNewName = fso.BuildPath(fso.GetParentFolderName(strSrcName), _
fso.GetBaseName(strSrcName) & "_" & ((nIndex-1) \ nSteps + 1) & "." & fso.GetExtensionName(strSrcName))
oNewDoc.SaveAs strNewName
oNewDoc.Close False
Next nIndex
Set oNewDoc = Nothing
Set oRange = Nothing
Set oSrcDoc = Nothing
Set fso = Nothing
MsgBox "结束！"
End Sub

4、按快捷键 F5 或工具栏中的运行按钮执行以上代码，等待跳出“完成”确认框。

2020/12/11 更新日志：

1、修复了分割文件后结尾多出空白页的问题

2、修复了分割文件名的序号从2开始的问题

原文链接地址：https://blog.exsvc.cn/article/split-word-files.html
转载请注明：转载自 易科博客 ，谢谢！