Split a Document

Split a Document

Hi 

I am not sure if this question was asked before, tried searching the forum 
but couldnât find a relative topic.

Basically I have a huge document consisting of abstracts for a conference. I 
have been asked to make individual file of each abstract, which means to copy 
paste each abstract from the main document into a new document. I was hoping 
that I can do it using VBA and avoid the manual work. Now the real issue is 
there is no text to identify start of an abstract, only way is to identify it 
is by its title which is Bold Times New Roman 12. 

The algorithm I am thinking of is to parse this document and look for the 
title, which will be basically to look for a line which is Bold Times New 
Roman 12 and then keep selecting the text till I find title of the next 
abstract means another line with Bold Times New Roman 12, open a new document 
and paste the selection into the new doc and move on to the next abstract. 

Or I can make a document like a TOC which lists all the abstract titles and 
from this document read two adjacent titles, select all the text in between 
those two lines from my main document and paste into a new document and move 
on to the next title. 

Or maybe the third way is to manually put tags at the start and end of an 
abstract and use those tags to select text in between and create new 
documents?

So which method you guys think will be easier to implement and ofcourse some 
sample code will help, since this is the first time I am using VBA? Thanks 
for the help

date: Wed, 20 Feb 2008 04:31:01 -0800 author: Saad

Re: Split a Document

Provided there are no section breaks in the document, the following will 
split the document at each Times New Roman Bold 12 title into separate files 
named according to that title with the addition of a number into a folder 
d:\My Documents\Test\Merge. Change that folder path where indicated to some 
suitable location on your hard drive. May I suggest that you work with a 
COPY of the document!!! http://www.gmayor.com/installing_macro.htm

Sub SplitAtFont()
Dim mask As String
Letters = Selection.Information(wdActiveEndSectionNumber)
With Selection
    .HomeKey Unit:=wdStory
    .MoveDown Unit:=wdLine
    With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = ""
        .Font.name = "Times New Roman"
        .Font.Size = "12"
        .Font.Bold = True
        .Wrap = wdFindStop
        Do While .Execute
            With Selection
                .HomeKey Unit:=wdLine
                .InsertBreak Type:=wdSectionBreakContinuous
                .MoveDown Unit:=wdLine
            End With
        Loop
    End With
    .EndKey Unit:=wdStory
    .InsertBreak Type:=wdSectionBreakContinuous
End With
Letters = Selection.Information(wdActiveEndSectionNumber)
Selection.HomeKey Unit:=wdStory
Counter = 1
While Counter < Letters
    Application.ScreenUpdating = False
    With Selection
       .HomeKey Unit:=wdStory
       .EndKey Unit:=wdLine, Extend:=wdExtend
       .MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    End With
    sName = Selection
'***********************************
    docName = "D:\My Documents\Test\Merge\" & sName & Counter & ".doc"
'***********************************
    ActiveDocument.Sections.First.Range.Cut
    Documents.Add
    With Selection
       .Paste
       .HomeKey Unit:=wdStory
       .MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
       .Delete
    End With
    ActiveDocument.SaveAs FileName:=docName, _
    FileFormat:=wdFormatDocument
    ActiveWindow.Close
    Counter = Counter + 1
    Application.ScreenUpdating = True
Wend
End Sub


-- 
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor -  Word MVP

My web site www.gmayor.com
Word MVP web site http://word.mvps.org
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Saad wrote:
> Hi
>
> I am not sure if this question was asked before, tried searching the
> forum but couldn't find a relative topic.
>
> Basically I have a huge document consisting of abstracts for a
> conference. I have been asked to make individual file of each
> abstract, which means to copy paste each abstract from the main
> document into a new document. I was hoping that I can do it using VBA
> and avoid the manual work. Now the real issue is there is no text to
> identify start of an abstract, only way is to identify it is by its
> title which is Bold Times New Roman 12.
>
> The algorithm I am thinking of is to parse this document and look for
> the title, which will be basically to look for a line which is Bold
> Times New Roman 12 and then keep selecting the text till I find title
> of the next abstract means another line with Bold Times New Roman 12,
> open a new document and paste the selection into the new doc and move
> on to the next abstract.
>
> Or I can make a document like a TOC which lists all the abstract
> titles and from this document read two adjacent titles, select all
> the text in between those two lines from my main document and paste
> into a new document and move on to the next title.
>
> Or maybe the third way is to manually put tags at the start and end
> of an abstract and use those tags to select text in between and
> create new documents?
>
> So which method you guys think will be easier to implement and
> ofcourse some sample code will help, since this is the first time I
> am using VBA? Thanks for the help

date: Wed, 20 Feb 2008 17:46:53 +0200 author: Graham Mayor

Re: Split a Document

Hey thanks I havn't checked this code yet but will do in morning, and yea 
document has sections but I can either first split it on basis of sections 
using foreach or I can do it manually theer arnt many sections

thanks again

date: Wed, 20 Feb 2008 14:54:01 -0800 author: Saad

Re: Split a Document

Hello Graham , I am afraid there is something slightly wrong with my file or 
code because the code gets stuck in an infinite loop. Plus I am not able to 
understand the code otherwise would have had solved the problem, is there any 
reference or starting tutorial on VBA and Word Objects?

Thanks

date: Thu, 21 Feb 2008 04:05:00 -0800 author: Saad

Re: Split a Document

Probably a bit of both :)

I have tidied the code up and annotated it. See if that helps. It would help 
to replace any section breaks with a paragraph break first. ie replace ^b 
with ^p as section breaks will confuse the second part of the macro.

Sub SplitAtFont()
Dim Letters As Integer
Dim Counter As Long
Dim sName As String
Dim docName As String

Application.ScreenUpdating = False
With Selection
    .HomeKey Unit:=wdStory 'move to the start of the document
    .MoveDown Unit:=wdLine 'move down one line
    With .Find 'locate Times New Roman 12 point Bold
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = ""
        .Font.name = "Times New Roman"
        .Font.Size = "12"
        .Font.Bold = True
        .Wrap = wdFindStop
        Do While .Execute ' and when found
            With Selection
                .HomeKey Unit:=wdLine 'move to the start of the line
                'and insert a section break
                .InsertBreak Type:=wdSectionBreakContinuous
                .MoveDown Unit:=wdLine 'move down one line
            End With
        Loop ' then find the next TNR 12 pont Bold
    End With
    .EndKey Unit:=wdStory ' go to the end of the document
    ' and add a section break
    .InsertBreak Type:=wdSectionBreakContinuous
End With
'define what Letters is
Letters = Selection.Information(wdActiveEndSectionNumber)
'go to the top of tyeh document
Selection.HomeKey Unit:=wdStory
Counter = 1 'set a counter
While Counter < Letters 'set the limits of the counter
    Application.ScreenUpdating = False
    With Selection 'grab some of the first line as a filename
       .HomeKey Unit:=wdStory
       .EndKey Unit:=wdLine, Extend:=wdExtend
       .MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    End With
    sName = Selection 'and apply it to a variable
'***********************************
'Format the name for the split document
    docName = "D:\My Documents\Test\Merge\" & sName & Counter & ".doc"
'***********************************
'Cut the first section to the clipboard
    ActiveDocument.Sections.First.Range.Cut
    Documents.Add 'open a new document
    Selection.Paste ' and paste the clipboard content
    'Save the document with the chosen filename
    ActiveDocument.SaveAs FileName:=docName, _
    FileFormat:=wdFormatDocument
    ActiveWindow.Close 'and close it
    Counter = Counter + 1 'increment the counter
    'Then go round again
Wend
    Application.ScreenUpdating = True
End Sub


-- 
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor -  Word MVP

My web site www.gmayor.com
Word MVP web site http://word.mvps.org
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Saad wrote:
> Hello Graham , I am afraid there is something slightly wrong with my
> file or code because the code gets stuck in an infinite loop. Plus I
> am not able to understand the code otherwise would have had solved
> the problem, is there any reference or starting tutorial on VBA and
> Word Objects?
>
> Thanks

date: Thu, 21 Feb 2008 17:53:50 +0200 author: Graham Mayor