none
Save Each Document Page in a Separate File RRS feed

  • Question

  • [Word 2007]

    I am trying to create a macro that saves each active document page in a separate file. My current code is:

    Option Explicit
    
    Sub SplitToPages()
    
    
    ' Save each page of the active document
    ' in a separate file
    ' A folder with the active document name
    ' is created at the document location
    
    
    ' If the document is not saved
    ' show a message and exit
    
    Dim objSourceDocument As Document
    Dim objPageDocument As Document
    
    Dim objFso As Object
    
    Dim strPath As String
    
    Dim intDocNum As Integer
    Dim i As Integer
    
    Set objSourceDocument = ActiveDocument
    
    If Len(objSourceDocument.Path) = 0 Then
      MsgBox "The document is not saved."
      Exit Sub
    End If
    
    Set objFso = CreateObject("Scripting.FileSystemObject")
    
    strPath = objSourceDocument.Path & "\" _
      & objFso.GetBaseName(objSourceDocument.Name)
    
    ' Check if the subfolder for new documents exists
      
    If objFso.FolderExists(strPath) Then
      If MsgBox("The folder: " & strPath & " already exists." _
        & vbCrLf & "Do you want to replace it?" & vbCrLf & vbCrLf _
        & "If you click Yes the folder contents will be deleted.", _
        vbYesNo) = vbYes Then
          objFso.DeleteFolder strPath
          objFso.CreateFolder strPath
      Else
        Exit Sub
      End If
    Else
      objFso.CreateFolder strPath
    End If
    
    intDocNum = 0
    
    ' Used to set criteria for moving through the document by page.
    
    Application.Browser.Target = wdBrowsePage
    Application.ScreenUpdating = False
    
    Selection.HomeKey Unit:=wdStory
    
    For i = 1 To objSourceDocument.BuiltInDocumentProperties("Number of Pages")
      
      'Select and copy the text to the clipboard
      objSourceDocument.Bookmarks("\page").Range.Copy
    
      ' Open new document to paste the content of the clipboard into.
      Set objPageDocument = Documents.Add(DocumentType:=ActiveDocument.Type)
      
      objPageDocument.Paragraphs(1).Format = Selection.Paragraphs(1).Format
      
      Selection.Paste
      ' Removes the break that is copied at the end of the page, if any.
      Selection.TypeBackspace
      intDocNum = intDocNum + 1
        
      objPageDocument.SaveAs FileName:=strPath & "\Page_" & intDocNum, _
        FileFormat:=objSourceDocument.SaveFormat
      objPageDocument.Close
      Set objPageDocument = Nothing
      ' Move the selection to the next page in the document
      Application.Browser.Next
    
    Next i
    
    Application.ScreenUpdating = True
    
    End Sub
    
    

     

    I created it based on this Microsoft Support article and this forum thread. It works fine except for one thing: some of the pages, when saved separately, span two pages, so I guess the formatting is not fully preserved. Can I change the code so that all newly created documents have only one page when opened?

     

     


    Uros Calakovic
    Thursday, February 24, 2011 7:21 PM

Answers

  • Try

    For i = 1 To objSourceDocument.BuiltInDocumentProperties("Number of Pages")
       Set objPageDocument = Documents.Add(DocumentType:=ActiveDocument.Type)
       objPageDocument.Range.FormattedText = objSourceDocument.Bookmarks("\page").Range.FormattedText
        objSourceDocument.Bookmarks("\page").Range.Cut
        objPageDocument.SaveAs FileName:=strPath & "\Page_" & intDocNum, _
           FileFormat:=objSourceDocument.SaveFormat
       objPageDocument.Close
       Set objPageDocument = Nothing
    Next i
    objSourceDocument.Close wdDoNotSaveChanges


    Hope this helps.

    Doug Robbins - Word MVP,
    dkr[atsymbol]mvps[dot]org
    Posted via the Community Bridge

    "urkec" wrote in message news:4f6afbe9-3976-4e5a-a941-6ef628c302c8@communitybridge.codeplex.com...

    [Word 2007]
    I am trying to create a macro that saves each active document page in a separate file. My current code is:


    Option Explicit Sub SplitToPages() ' Save each page of the active document ' in a separate file ' A folder with the active document name ' is created at the document location ' If the document is not saved ' show a message and exit Dim objSourceDocument As Document Dim objPageDocument As Document Dim objFso As Object Dim strPath As String Dim intDocNum As Integer Dim i As Integer Set objSourceDocument = ActiveDocument If Len(objSourceDocument.Path) = 0 Then MsgBox "The document is not saved." Exit Sub End If Set objFso = CreateObject("Scripting.FileSystemObject") strPath = objSourceDocument.Path & "\" _ & objFso.GetBaseName(objSourceDocument.Name) ' Check if the subfolder for new documents exists If objFso.FolderExists(strPath) Then If MsgBox("The folder: " & strPath & " already exists." _ & vbCrLf & "Do you want to replace it?" & vbCrLf & vbCrLf _ & "If you click Yes the folder contents will be deleted.", _ vbYesNo) = vbYes Then objFso.DeleteFolder strPath objFso.CreateFolder strPath Else Exit Sub End If Else objFso.CreateFolder strPath End If intDocNum = 0 ' Used to set criteria for moving through the document by page. Application.Browser.Target = wdBrowsePage Application.ScreenUpdating = False Selection.HomeKey Unit:=wdStory For i = 1 To objSourceDocument.BuiltInDocumentProperties("Number of Pages") 'Select and copy the text to the clipboard objSourceDocument.Bookmarks("\page").Range.Copy ' Open new document to paste the content of the clipboard into. Set objPageDocument = Documents.Add(DocumentType:=ActiveDocument.Type) objPageDocument.Paragraphs(1).Format = Selection.Paragraphs(1).Format Selection.Paste ' Removes the break that is copied at the end of the page, if any. Selection.TypeBackspace intDocNum = intDocNum + 1 objPageDocument.SaveAs FileName:=strPath & "\Page_" & intDocNum, _ FileFormat:=objSourceDocument.SaveFormat objPageDocument.Close Set objPageDocument = Nothing ' Move the selection to the next page in the document Application.Browser.Next Next i Application.ScreenUpdating = True End Sub



    I created it based on this <http://support.microsoft.com/?kbid=216845> Microsoft Support article andthis <http://social.msdn.microsoft.com/Forums/en/worddev/thread/1f2d95e7-2f8d-4928-a94c-eff448df01ee> forum thread. It works fine except for one thing: some of the pages, when saved separately, span two pages, so I guess the formatting is not fully preserved. Can I change the code so that all newly created documents have only one page when opened?




    Uros Calakovic


    Doug Robbins - Word MVP dkr[atsymbol]mvps[dot]org
    • Marked as answer by Anonimista Saturday, February 26, 2011 8:13 AM
    Thursday, February 24, 2011 8:22 PM

All replies

  • Try

    For i = 1 To objSourceDocument.BuiltInDocumentProperties("Number of Pages")
       Set objPageDocument = Documents.Add(DocumentType:=ActiveDocument.Type)
       objPageDocument.Range.FormattedText = objSourceDocument.Bookmarks("\page").Range.FormattedText
        objSourceDocument.Bookmarks("\page").Range.Cut
        objPageDocument.SaveAs FileName:=strPath & "\Page_" & intDocNum, _
           FileFormat:=objSourceDocument.SaveFormat
       objPageDocument.Close
       Set objPageDocument = Nothing
    Next i
    objSourceDocument.Close wdDoNotSaveChanges


    Hope this helps.

    Doug Robbins - Word MVP,
    dkr[atsymbol]mvps[dot]org
    Posted via the Community Bridge

    "urkec" wrote in message news:4f6afbe9-3976-4e5a-a941-6ef628c302c8@communitybridge.codeplex.com...

    [Word 2007]
    I am trying to create a macro that saves each active document page in a separate file. My current code is:


    Option Explicit Sub SplitToPages() ' Save each page of the active document ' in a separate file ' A folder with the active document name ' is created at the document location ' If the document is not saved ' show a message and exit Dim objSourceDocument As Document Dim objPageDocument As Document Dim objFso As Object Dim strPath As String Dim intDocNum As Integer Dim i As Integer Set objSourceDocument = ActiveDocument If Len(objSourceDocument.Path) = 0 Then MsgBox "The document is not saved." Exit Sub End If Set objFso = CreateObject("Scripting.FileSystemObject") strPath = objSourceDocument.Path & "\" _ & objFso.GetBaseName(objSourceDocument.Name) ' Check if the subfolder for new documents exists If objFso.FolderExists(strPath) Then If MsgBox("The folder: " & strPath & " already exists." _ & vbCrLf & "Do you want to replace it?" & vbCrLf & vbCrLf _ & "If you click Yes the folder contents will be deleted.", _ vbYesNo) = vbYes Then objFso.DeleteFolder strPath objFso.CreateFolder strPath Else Exit Sub End If Else objFso.CreateFolder strPath End If intDocNum = 0 ' Used to set criteria for moving through the document by page. Application.Browser.Target = wdBrowsePage Application.ScreenUpdating = False Selection.HomeKey Unit:=wdStory For i = 1 To objSourceDocument.BuiltInDocumentProperties("Number of Pages") 'Select and copy the text to the clipboard objSourceDocument.Bookmarks("\page").Range.Copy ' Open new document to paste the content of the clipboard into. Set objPageDocument = Documents.Add(DocumentType:=ActiveDocument.Type) objPageDocument.Paragraphs(1).Format = Selection.Paragraphs(1).Format Selection.Paste ' Removes the break that is copied at the end of the page, if any. Selection.TypeBackspace intDocNum = intDocNum + 1 objPageDocument.SaveAs FileName:=strPath & "\Page_" & intDocNum, _ FileFormat:=objSourceDocument.SaveFormat objPageDocument.Close Set objPageDocument = Nothing ' Move the selection to the next page in the document Application.Browser.Next Next i Application.ScreenUpdating = True End Sub



    I created it based on this <http://support.microsoft.com/?kbid=216845> Microsoft Support article andthis <http://social.msdn.microsoft.com/Forums/en/worddev/thread/1f2d95e7-2f8d-4928-a94c-eff448df01ee> forum thread. It works fine except for one thing: some of the pages, when saved separately, span two pages, so I guess the formatting is not fully preserved. Can I change the code so that all newly created documents have only one page when opened?




    Uros Calakovic


    Doug Robbins - Word MVP dkr[atsymbol]mvps[dot]org
    • Marked as answer by Anonimista Saturday, February 26, 2011 8:13 AM
    Thursday, February 24, 2011 8:22 PM
  • Thank you for the response.

    When I use your code I get this error:

    Run-time error '5941':

    The requested member of the collection does not exist.

    I get the same error when I try to echo the FormattedText contents:

    MsgBox objSourceDocument.Bookmarks("\page").Range.FormattedText.Text


    Uros Calakovic
    Friday, February 25, 2011 3:02 PM
  • Do not use .FormattedText.Text

    Using

    MsgBox ActiveDocument.Bookmarks("\page").Range.FormattedText

    does not cause an error here, though the message box cannot of course show the text formatting.


    Hope this helps.

    Doug Robbins - Word MVP,
    dkr[atsymbol]mvps[dot]org
    Posted via the Community Bridge

    "urkec" wrote in message news:987fb646-4fae-4414-a9cc-84d40d09dff6@communitybridge.codeplex.com...

    Thank you for the response.

    When I use your code I get this error:

    Run-time error '5941':

    The requested member of the collection does not exist.

    I get the same error when I try to echo the FormattedText contents:

    MsgBox objSourceDocument.Bookmarks("\page").Range.FormattedText.Text


    Uros Calakovic


    Doug Robbins - Word MVP dkr[atsymbol]mvps[dot]org
    Friday, February 25, 2011 9:09 PM