VBScript/VBS/VBA split single word document to multi-documents by pages

msoWord_SplitPages.vbs

'
' 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

' Example:
'
' Dim obj
' Set obj = New msoWord_SplitPages
'     obj.setPageWidth 2
'     obj.setPageSkipWidth 1
'     obj.setFileName "D:\test\testmultipages.doc"
'     MsgBox obj.execute
' Set obj = Nothing

Hi,

This code is not working properly with attached file.

1. Extra page is added at the end of each part.
2. Formatting is not correct.

Can you please check and help me out?