Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Westi on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Spli MS Word 2003 doc by manual page breaks and include last page or pages 1

Status
Not open for further replies.

patriciaxxx

Programmer
Jan 30, 2012
277
GB
this is my code so far

it finds all the manual page breaks in the file it is run on and splits them copying them into separate new files.

the problem is the last page or pages that follow the final manual page break are not included.


Code:
Option Explicit 'This goes in the Declarations section of your code module.
'Hopefully it is already there because you have ticked the 'Require Variable Declaration' _
checkbox. (Tools/Options, Editor tab.)


'Sub SplitIntoPages()
Sub SplitFromSectionBreak()
'use this to split document from section break


   Dim i
   Selection.HomeKey Unit:=wdStory
   Application.ScreenUpdating = False
'------ count how much section in document---------

Dim j As Long

Dim msg As String
msg = ""
Dim S As Section, R As Range
For Each S In ActiveDocument.Sections
    j = 0
    Set R = S.Range
    Do While R.Find.Execute(FindText:="^m") = True
        If R.Start > S.Range.End Then Exit Do

        j = j + 1
    Loop
    msg = msg & "There are " & j & " hard page breaks in Section " & S.Index & "; "
Next

msg = Left(msg, Len(msg) - 2) & "."
MsgBox msg


 '  MsgBox (ActiveDocument.Sections.Count - 1 & " Sections Found In This Document")
'-------set path where file to save----------------
   Dim path As String
   'path = InputBox(ActiveDocument.Sections.Count - 1 & " Sections Found In This Document" & vbCrLf & vbCrLf & "Enter The Destination Folder You Want To Save Files. ", "Path", ActiveDocument.path & "\")
   path = InputBox(j & " Sections Found In This Document" & vbCrLf & vbCrLf & "Enter The Destination Folder You Want To Save Files. ", "Path", ActiveDocument.path & "\")

   For i = 0 To j
    With Selection.Find
    .Text = "^m"
    .Forward = False
    .Execute
    .Text = ""
    End With

    Selection.Extend

    With Selection.Find
    .Text = "^m"
    .Forward = True
    .Wrap = wdFindStop
    .Execute
    .Text = ""

    End With
        Selection.Copy
        Documents.Add
        Selection.Paste
        
' this macro also associated with Delete_SectionBreaks()
'TO DELETE ALL SECTIONS IN DOCUMENT
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

With Selection.Find
'  .Text = "^12"
  .Text = "^m"
  .Replacement.Text = ""
  .Forward = True
  .Wrap = wdFindContinue
  .Format = True
  .MatchCase = False
  .MatchWholeWord = False
  .MatchWildcards = False
  .MatchSoundsLike = False
  .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
'-----------------------------------------------------------------------
'        If Dir(path) = "" Then MkDir path  'If path doesn't exist create one

        ChangeFileOpenDirectory path
Dim DocNum As Integer

        DocNum = DocNum + 1
        ActiveDocument.SaveAs FileName:="Section_" & DocNum & ".doc"
        ActiveDocument.Close

    Next i
    path = "c:\"
    ChangeFileOpenDirectory path
End Sub
 
So what part do the Section breaks play with what you're trying to do -vs- the page breaks? If they're not determinative, have you thought of replacing the page breaks with Section breaks, then processing by Section?

Cheers
Paul Edstein
[MS MVP - Word]
 
Yes I tried it with the section breaks, that seems to work, thank you Paul.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top