Skip to content

Instantly share code, notes, and snippets.

@wangye
Created March 2, 2012 07:22
Show Gist options
  • Save wangye/1956435 to your computer and use it in GitHub Desktop.
Save wangye/1956435 to your computer and use it in GitHub Desktop.
VBScript/VBS/VBA split single word document to multi-documents by pages
'
' 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
@navneetgzb
Copy link

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?

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment