stevembe
11-26-2013, 01:31 PM
Hoping somebody can help. I am using the following code that works perfectly less for one thing. The merged document has paragraph spaces that look like this:
Line of text
¶
Line of text
However when run it extracts single documents but adds a blank space so it looks like this:
Line of text
¶
Line of text
There is no character showing for this space and it is throwing all the pages out of sync. Has anybody please got any advice?
Sub BreakOnSection()
Application.Browser.Target = wdBrowseSection
For i = 1 To ((ActiveDocument.Sections.Count) - 1)
ActiveDocument.Bookmarks("\Section").Range.Copy
Documents.Add
Selection.Paste
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
txtname = ActiveDocument.Range(Start:=ActiveDocument.Sentences(4).Start, End:=ActiveDocument.Sentences(4).End - 1).Text & ActiveDocument.Range(Start:=ActiveDocument.Sentences(5).Start, End:=ActiveDocument.Sentences(5).End - 1).Text
ChangeFileOpenDirectory "H:\Terms & Conditions\Test Unmerge"
'ActiveDocument.SaveAs FileName:="Terms & Conditions_" & Right(txtName, j - 1) & "_" & Left(txtName, Len(txtName) - j) & ".doc"
ActiveDocument.SaveAs FileName:=txtname & ".doc"
ActiveDocument.Close
Application.Browser.Next
Next i
'ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub
Line of text
¶
Line of text
However when run it extracts single documents but adds a blank space so it looks like this:
Line of text
¶
Line of text
There is no character showing for this space and it is throwing all the pages out of sync. Has anybody please got any advice?
Sub BreakOnSection()
Application.Browser.Target = wdBrowseSection
For i = 1 To ((ActiveDocument.Sections.Count) - 1)
ActiveDocument.Bookmarks("\Section").Range.Copy
Documents.Add
Selection.Paste
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
txtname = ActiveDocument.Range(Start:=ActiveDocument.Sentences(4).Start, End:=ActiveDocument.Sentences(4).End - 1).Text & ActiveDocument.Range(Start:=ActiveDocument.Sentences(5).Start, End:=ActiveDocument.Sentences(5).End - 1).Text
ChangeFileOpenDirectory "H:\Terms & Conditions\Test Unmerge"
'ActiveDocument.SaveAs FileName:="Terms & Conditions_" & Right(txtName, j - 1) & "_" & Left(txtName, Len(txtName) - j) & ".doc"
ActiveDocument.SaveAs FileName:=txtname & ".doc"
ActiveDocument.Close
Application.Browser.Next
Next i
'ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub