Extract Pages From Word Document

extractPages.vba

' Found in https://www.datanumen.com/blogs/2-quick-ways-extract-individual-pages-word-document/

Sub SaveEachPageAsADoc()
  Dim objNewDoc As Document
  Dim objDoc As Document
  Dim nPageNumber As Integer
  Dim strFolder As String
  Dim objFileName As Range
 
  '  Initialization
  Set objDoc = ActiveDocument
 
  strFolder = InputBox("Enter folder path here: ")
 
  '  Copy each page in the document to paste it into a new one.
  For nPageNumber = 1 To ActiveDocument.ComputeStatistics(wdStatisticPages)
    Application.Browser.Target = wdBrowsePage
    ActiveDocument.Bookmarks("\page").Range.Select
    Selection.Copy
 
    Set objNewDoc = Documents.Add
    Selection.Paste
 
    objNewDoc.SaveAs FileName:=strFolder & "\" & "Page " & nPageNumber & ".docx"
    objNewDoc.Close
    Application.Browser.Next
  Next nPageNumber
End Sub