patriciaxxx
Programmer
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.
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