VBA Word, Split Word File into Multiple Files (Every X Pages)
In this article I will explain how you can use VBA for Word to split a word document every X pages. Each section will be saved in a separate document.
Contents
Splitting Every X Pages:
In this example the word document will be split every 3 pages. Assume we have the following data in the word document:
The code below will split the document every 3 pages:
Sub Example1() Dim i As Integer Dim flag As Boolean Dim intLastPage As Integer Dim strPrevBM As String Dim strNextBM As String Dim objDocument As Document Dim intPageCount As Integer Dim intCurrentPage As Integer Dim strPath As String Dim intIndex As Integer '''changing this line will change the way the documents are split intPageCount = 3 flag = True ThisDocument.Activate 'get last page number intLastPage = Range.Information(wdActiveEndPageNumber) 'move to the start of the document Selection.HomeKey Unit:=wdStory 'create a bookmark at the start of the documnet With ActiveDocument.Bookmarks .Add Range:=Selection.Range, Name:="PG1" .DefaultSorting = wdSortByName .ShowHidden = False End With strPrevBM = "PG1" 'the current page the cursor is on intCurrentPage = Selection.Information( _ wdActiveEndPageNumber) intIndex = 1 'keep going until the end of the document is reached While intCurrentPage <= intLastPage And flag = True 'if the end of the document hasn't been reached If intPageCount + intCurrentPage <= intLastPage Then Selection.GoTo what:=wdGoToPage, _ Which:=wdGoToNext, Name:=intPageCount _ + intCurrentPage Selection.MoveLeft Unit:=wdCharacter, Count:=1 Else Selection.EndKey Unit:=wdStory End If 'get the current page number intCurrentPage = Selection.Information( _ wdActiveEndPageNumber) 'create a new bookmark With ActiveDocument.Bookmarks .Add Range:=Selection.Range, Name:="PG" & _ Selection.Information(wdActiveEndPageNumber) + 1 .DefaultSorting = wdSortByName .ShowHidden = False End With strNextBM = "PG" & _ Selection.Information(wdActiveEndPageNumber) + 1 'select between the two bookmarks Selection.Start = Bookmarks(strPrevBM).End Selection.End = Bookmarks(strNextBM).Start 'copy the selection Selection.Copy 'create a new documnet Set objDocument = Documents.Add 'activate the document objDocument.Activate 'paste the copied text to the document Selection.PasteAndFormat (wdFormatOriginalFormatting) Selection.TypeBackspace intIndex = intIndex + 1 ThisDocument.Activate 'delete the bookmarks ThisDocument.Bookmarks(strPrevBM).Delete ThisDocument.Bookmarks(strNextBM).Delete 'create a new bookmark If intIndex = 10 Then Beep End If If intCurrentPage < intLastPage Then Selection.MoveRight Unit:=wdCharacter, Count:=2 With ActiveDocument.Bookmarks .Add Range:=Selection.Range, Name:="PG" & _ Selection.Information( _ wdActiveEndPageNumber) .DefaultSorting = wdSortByName .ShowHidden = False End With strPrevBM = "PG" & _ Selection.Information(wdActiveEndPageNumber) 'get the current page number intCurrentPage = Selection.Information( _ wdActiveEndPageNumber) Else flag = False End If Wend End Sub
Result:
Concept:
The program uses the following algorithm:
- Go to the first line of the first page
- Create a bookmark
- Move X pages down
- Create another bookmark
- Select the text between the two bookmarks
- Copy the selected text
- Create a new word document object
- Paste the data to the new document
- Remove the bookmarks
- If the end of the document hasn’t been reached return to step 3
Code Clarification:
In line 15 the user selects “X”, where “X” is the number of pages in each of the new documents. The current value is 3 so the document will be split every 3 pages. Line 20 gets the number of pages in the document. Lines 24~27 create a bookmark at the start of the document. The while loop on line 35 continues until the end of the document is reached. Line 37 checks if this is the last part. If so the cursor is moved to the end of the document, else the cursor is moved X pages forward. Line 49~54 create a new bookmark at the cursor location. Lines 58 and 59 select all text between the 2 consecutive bookmarks. Lines 61~67 copy the selected content and copy it onto a new document. Lines 72 and 73 delete the 3 bookmarks. Lines 82~94 create a new bookmark for the next 3 pages.
Save and Close:
By adding the following lines to the code, a folder dialog will appear at the start of the program asking the user to select a path to save the newly created documents. For more information about folder dialog please see the link below:
Sub Example2() Dim i As Integer Dim flag As Boolean Dim intLastPage As Integer Dim strPrevBM As String Dim strNextBM As String Dim objDocument As Document Dim intPageCount As Integer Dim intCurrentPage As Integer Dim strPath As String Dim intIndex As Integer Dim intResult As Integer intPageCount = 3 flag = True 'the dialog is displayed to the user intResult = Application.FileDialog(msoFileDialogFolderPicker).Show 'checks if user has cancled the dialog If intResult <> 0 Then 'dispaly message box strPath = Application.FileDialog(msoFileDialogFolderPicker _ ).SelectedItems(1) 'You can change this ThisDocument.Activate 'get last page number intLastPage = Range.Information(wdActiveEndPageNumber) 'move to the start of the document Selection.HomeKey Unit:=wdStory 'create a bookmark at the start of the documnet With ActiveDocument.Bookmarks .Add Range:=Selection.Range, Name:="PG1" .DefaultSorting = wdSortByName .ShowHidden = False End With strPrevBM = "PG1" 'the current page the cursor is on intCurrentPage = Selection.Information( _ wdActiveEndPageNumber) intIndex = 1 'keep going until the end of the document is reached While intCurrentPage <= intLastPage And flag = True 'if the end of the document hasn't been reached If intPageCount + intCurrentPage <= intLastPage Then Selection.GoTo what:=wdGoToPage, _ Which:=wdGoToNext, Name:=intPageCount _ + intCurrentPage Selection.MoveLeft Unit:=wdCharacter, Count:=1 Else Selection.EndKey Unit:=wdStory End If 'get the current page number intCurrentPage = Selection.Information( _ wdActiveEndPageNumber) 'create a new bookmark With ActiveDocument.Bookmarks .Add Range:=Selection.Range, Name:="PG" & _ Selection.Information(wdActiveEndPageNumber) + 1 .DefaultSorting = wdSortByName .ShowHidden = False End With strNextBM = "PG" & _ Selection.Information(wdActiveEndPageNumber) + 1 'select between the two bookmarks Selection.Start = Bookmarks(strPrevBM).End Selection.End = Bookmarks(strNextBM).Start 'copy the selection Selection.Copy 'create a new documnet Set objDocument = Documents.Add 'activate the document objDocument.Activate 'paste the copied text to the document Selection.PasteAndFormat (wdFormatOriginalFormatting) Selection.TypeBackspace objDocument.SaveAs2 (strPath & "" & intIndex) intIndex = intIndex + 1 objDocument.Close ThisDocument.Activate 'delete the bookmarks ThisDocument.Bookmarks(strPrevBM).Delete ThisDocument.Bookmarks(strNextBM).Delete 'create a new bookmark If intIndex = 10 Then Beep End If If intCurrentPage < intLastPage Then Selection.MoveRight Unit:=wdCharacter, Count:=2 With ActiveDocument.Bookmarks .Add Range:=Selection.Range, Name:="PG" & _ Selection.Information( _ wdActiveEndPageNumber) .DefaultSorting = wdSortByName .ShowHidden = False End With strPrevBM = "PG" & _ Selection.Information(wdActiveEndPageNumber) 'get the current page number intCurrentPage = Selection.Information( _ wdActiveEndPageNumber) Else flag = False End If Wend End If End Sub
Folder Dialog:
You can download the files and code related to this article from the link below:
See also:
If you need assistance with your code, or you are looking for a VBA programmer to hire feel free to contact me. Also please visit my website www.software-solutions-online.com
19 thoughts on “VBA Word, Split Word File into Multiple Files (Every X Pages)”