提醒：本页面将不再更新、维护或者支持，文章、评论所叙述内容存在时效性，涉及技术细节或者软件使用方面不保证能够完全有效可操作，请谨慎参考！

标题可能不是很恰当，准确的来说就是将一个有很多页面的Word文档按照指定的页数分解为多个独立的Word文档。本来想通过复制指定页内容然后再新建Word来实现的，后来发现这样做一是很麻烦，二是格式容易错。最后想到了一个比较笨的办法：复制一份原稿，然后除了要保留的页面外，其余的统统删去，然后下个页面再复制一份，以此反复，直到完成全部的拆分。

对于页面的删除，可以通过先选中这个页面内容，然后再执行 Selection.Delete 方法。这样删除不需要的页面后留下的就是我们需要保留的页面了，这份文档算是完成。

这里有个需要注意的地方，保留Word文档N页中第M页共P页，需要执行两步删除，第一步是删除M页之前的所有页面，第二步是删除M+P页之后的所有页面，然后得到的就是所要的。细节方面就是当执行第一步后，第M页会自动转为第1页（因为前面的都删除了），所以我们接下来执行第二步的时候需要从第1+P页开始，另外如果M=1，说明需要保留从第一页开始，那么第一步可以略去，如果M+P>=总页数，则说明需要保留的包含最后一页，那么第二步就可以略去。

下面提供一份VBScript Class msoWord_SplitPages，其中演示了上面的算法思路，供大家参考：

'
' Description: VBScript/VBS/VBA
'              split single word document
'              to multi-documents by pages
' Author: wangye  <pcn88 at hotmail dot com>
' Website: http://wangye.org
' Copyright by author
'
Const PrevPage = 0
Const NextPage = 1
Class msoWord_SplitPages
  Private m_nFromPage
  Private m_nToPage
  Private m_nTotalPages
  Private m_nPageWidth
  Private m_wdApp
  Private m_strFileName
  Private m_strDestFilePath
  Private m_nPageSkipWidth
  
  Private Sub Class_Initialize()
    Set m_wdApp = WSH.CreateObject("Word.Application")
    m_wdApp.Visible = True
    m_nPageSkipWidth = 0
    m_nPageWidth = 1
    m_nFromPage = 1
    m_nToPage = 0
  End Sub
  
  Private Sub Class_Terminate()
    m_wdApp.Visible = True
    m_wdApp.Quit
    Set m_wdApp = Nothing
  End Sub
  
  Private Function getTotalPages(filename)
    Const wdNumberOfPagesInDocument = 4
    Dim doc
    Set doc = m_wdApp.Documents.Open(filename)
      getTotalPages = _
        m_wdApp.Selection.Information(wdNumberOfPagesInDocument)
      doc.Close
    Set doc = Nothing
  End Function
  
  Private Function isPagesValid()
    isPagesValid = CBool(m_nFromPage<=m_nToPage And _
        m_nFromPage>0 And m_nToPage<=m_nTotalPages)
  End Function
  
  ' keepPage Need keep pages
  ' t        delete type PrevPage or Next Page
  Private Sub deletePages(keepPage, t)
    Const wdGoToPage = 1
    Const wdGoToNext = 2
    Const wdStory = 6
    
    Dim Range,Selection
    Dim Range1, Range2
    
    If Not isPagesValid() Then Exit Sub
    If t=PrevPage And keepPage<1 Then Exit Sub
    If t=NextPage And keepPage>m_nTotalPages Then Exit Sub
    
    Set Selection = m_wdApp.Selection
    Set Range = m_wdApp.Selection.Range

      Selection.GoTo wdGoToPage, wdGoToNext, keepPage
      Selection.Select
    
      Set Range1 = Selection.Range
        If t=PrevPage Then
          Selection.HomeKey wdStory
        Else
          Selection.EndKey wdStory
        End If
        Selection.Select
        Set Range2 = Selection.Range
        If t=PrevPage Then
          Range.Start = Range2.Start
          Range.End = Range1.End
        Else
          Range.Start = Range1.Start
          Range.End = Range2.End
        End If
          Range.Select
          Selection.Delete
          Selection.TypeBackspace
        Set Range2 = Nothing
      Set Range1 = Nothing
    Set Range = Nothing
    Set Selection = Nothing
  End Sub
  
  Private Function min_(a, b)
    If a>b Then
      min_ = b
    Else
      min_ = a
    End If
  End Function
  
  ' 设置拆分页面的起始页数（初始为1）
  Public Sub setFromPage(p)
    m_nFromPage = p
  End Sub
  
  ' 设置拆分页面的末尾页数（初始为总页数）
  Public Sub setToPage(p)
    m_nToPage = p
  End Sub
  
  ' 设置每次拆分所需要保留的页数
  Public Sub setPageWidth(p)
    m_nPageWidth = p
  End Sub
  
  ' 设置执行拆分跳过的页数
  Public Sub setPageSkipWidth(p)
    m_nPageSkipWidth = p
  End Sub
  
  ' 设置源Word文件路径
  Public Sub setFileName(fn)
    m_strFileName = fn
  End Sub
  
  ' 设置拆分后的多个Word文件所在的文件夹
  Public Sub setDestFilePath(fn)
    m_strDestFilePath = fn
  End Sub

  ' 执行函数
  Public Function execute()
    execute = False
    
    m_nTotalPages = getTotalPages(m_strFileName)
    If m_nToPage <1 Then m_nToPage = m_nTotalPages
    If Not isPagesValid() Then Exit Function
    Dim i,fso,doc
    Set fso = WSH.CreateObject("Scripting.FileSystemObject")
    
    If m_strFileName="" Or (Not fso.FileExists(m_strFileName)) Then
      Exit Function
    End If
    
    If m_strDestFilePath="" Or (Not fso.FolderExists(m_strDestFilePath)) Then
      m_strDestFilePath = fso.GetParentFolderName(m_strFileName)
    End If
    
    Dim strTempFileName
    For i=m_nFromPage To _
      min_(m_nToPage, m_nTotalPages) Step m_nPageSkipWidth+1
      ' 复制一份临时文档供我们删减
      strTempFileName = m_strDestFilePath & "\~$tmp" & i & fso.GetTempName
      fso.CopyFile m_strFileName, strTempFileName
      Set doc = m_wdApp.Documents.Open(strTempFileName)
        If i>1 Then
          deletePages i-1, PrevPage
        End If
        If (i+m_nPageWidth-1)<m_nTotalPages Then
          deletePages m_nPageWidth, NextPage
        End If
        doc.Save
        doc.Close
      Set doc = Nothing
      ' 将处理完的临时文档按页码复制回指定文件夹
      fso.MoveFile strTempFileName, m_strDestFilePath & "\" & i & ".doc"
    Next
    
    Set fso = Nothing
    execute = True
  End Function
End Class

上面的VBS会要求拆分的页码范围，一般不指定的话就意味着整个文档作为拆分对象（从第一页到最后一页），如果未指定ToPage终止页，那么将默认为这个文档的最后一页，脚本需要打开一次文档并利用wdNumberOfPagesInDocument来决定文档总页数。接下来给个调用例子：

Dim obj
Set obj = New msoWord_SplitPages
    obj.setPageWidth 2
    obj.setPageSkipWidth 1
    obj.setFileName "D:\src\test.doc"
    obj.setDestFilePath "D:\dest"
    MsgBox obj.execute
Set obj = Nothing

上述代码将拆分test.doc的第1,2页、第3,4页等等为单独的Word文档，这里拆分的方式由PageWidth和PageSkipWidth决定，因为PageWidth是2所以一次拆分2页，PageSkipWidth设为1决定了第一次从第1页开始，那么第二次就应该从第3页开始，默认PageSkipWidth为0，也就是第一次从第1页开始，第二次就从第2页开始了。当然关于这个操作的逆操作就是将多个Word文档合并成一个文档，可以参考 《VBScript/VBA批量合并多个Word文件到一个文件》 。好了，代码已经放到 github的gist 上了，欢迎交流。