MS Word Extract Pages

word_extract_pages

' Macro to Extract pages
Sub mcrExtractPages()
    Application.Browser.Target = wdBrowsePage
     For i = 1 To ActiveDocument.BuiltInDocumentProperties("Number of Pages")
        ActiveDocument.Bookmarks("\page").Range.Copy
        Documents.Add
        Selection.Paste
        ChangeFileOpenDirectory "C:\Temp"
        DocNum = DocNum + 1
        ActiveDocument.SaveAs FileName:="ExtractedPage_" & DocNum & ".docx"
        ActiveDocument.Close
        Application.Browser.Next
     Next i
End Sub