VBA Word, Split Word File into Multiple Files (Every X Pages)

by azurous in Automation

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:

Word, VBA, Split DocumentThe 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:

Word VBA, Split Document Based on Pages

–

Concept:

The program uses the following algorithm:

  1. Go to the first line of the first page
  2. Create a bookmark
  3. Move X pages down
  4. Create another bookmark
  5. Select the text between the two bookmarks
  6. Copy the selected text
  7. Create a new word document object
  8. Paste the data to the new document
  9. Remove the bookmarks
  10. 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:

Folder Dialog Word
Result:

Word, VBA Split Result

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

Tagged with: , , ,

19 thoughts on “VBA Word, Split Word File into Multiple Files (Every X Pages)”

Leave a Reply

Your email address will not be published. Required fields are marked *