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.


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

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

  1. nicky says:

    I tried using both macros above but getting a compile error: sub or function not defined and it’s highlighting the Word Bookmarks on line 64. This one looked the most promising of all the splitting macros as i have a large document made from a mail merge which goes onto two pages for each recipient but all of the splitters i have seen either split by one page or use section/page breaks which would also take a lot of manual work for a 400 document page.

    Would you please be able to advise or let me know if the code has been updated?

    Thanks
    Nicky

    1. pedrumj says:

      Hi there. Could you please email me the word document you are testing this macro in. Thanks

  2. Du Felix says:

    Why u have given the count as 2 , instead of 1 in the following :

    ‘delete the bookmarks
    ThisDocument.Bookmarks(strPrevBM).Delete
    ThisDocument.Bookmarks(strNextBM).Delete
    ‘create a new bookmark
    If intCurrentPage < intLastPage Then
    Selection.MoveRight Unit:=wdCharacter, Count:=2

    1. pedrumj says:

      Hi there

      If you debug the code you will see that before executing that line, the entire page is selected. Moving “right” once will only deselect the page. It is the second time that will move the cursor to the next page.

      Let me know if you are still having trouble 🙂

      1. leslyarun says:

        It wont select the first character in the page, if u move right 2 times.
        So u should give count as 1

        1. pedrumj says:

          Please send me your file and I will have a look at it.

      2. leslyarun says:

        How to send the file to u ?

        1. pedrumj says:

          You can find my email on the contact page.

  3. Calibri says:

    Unfortunately,

    i have the same problem as Du Felix describes.
    Tried several other lines, or tweak the lines a bit, but no luck.

    Need some help 🙂

  4. Calibri says:

    I’m sorry,

    I meant the same problem as Nicky describes..
    The bookmark section.

    Like to know how to tweak that.

    1. pedrumj says:

      Hi there

      Could you please send me the file you are testing the code with so that I could have a look at it. Thanks

  5. Zdravko says:

    Works great, saved me a lot of time. Thanks a lot.

  6. Bobby says:

    I am getting errors as well when trying it with a large mail merged document. Can you help?

  7. Erin says:

    I downloaded the document and macros you included, but got the same error as everyone else regarding the bookmarks (compile error: sub or function not defined and it’s highlighting the Word Bookmarks on line 64.)

  8. branson says:

    Hey folks, I tried and found out the reason:
    You shouldn’t put the code in module, you should put the code directly inside Microsoft Object -> ThisDocument

    Again thanks for the code, it’s a life-saver

Leave a Reply

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