Splitting large document

[leecable]

Good afternoon,

First time poster, and pretty much a newbie using VBA. I have been set a challenge to split a large document into lots of smaller documents by specific parameters.

This is what ive found so far..

Sub SplitNotes(delim As String, strFilename As String)
Dim doc As Document
Dim arrNotes
Dim I As Long
Dim X As Long
Dim Response As Integer
arrNotes = Split(ActiveDocument.Range, delim)
Response = MsgBox("This will split the document into " & UBound(arrNotes) + 1 & " sections.Do you wish to proceed?", 4)
If Response = 7 Then Exit Sub
For I = LBound(arrNotes) To UBound(arrNotes)
If Trim(arrNotes(I)) <> "" Then
X = X + 1
Set doc = Documents.Add
doc.Range = arrNotes(I)
doc.SaveAs ThisDocument.Path & "\" & strFilename & Format(X, "000")
doc.Close True
End If
Next I
End Sub
Sub test()
'delimiter & filename
SplitNotes "///", "Notes "
End Sub

Now, I can see where I need to put the 'delimiter' information. For the document ill be using ',,,,,' after each block of text that has to be split. The issue ive got is, the document is about 2500 pages long, and its going to take me a fair while to sit and split each thing with my delimiter. Is there a quicker way? The documents vary in length so this is making it a little more tricky!

The other question is, within each specific document there is a title and a description. I want each document to be named with the title and description values, from each specific document.

Whilst i'd be grateful for the answer, an explanation of how you did it, would also be great! Wanting to learn!

And yes, ive tried google.


Thanks folks!

[gmaxey]

Maybe the document is already delimited by some other means. See: http://gregmaxey.com/word_tip_pages/..._splitter.html

If not then you will have to delimit it. Perhaps you could use find and replace to insert the delimiter

[leecable]

Your splitter looks glorious Greg! I shall have a peruse and see if it is delimit'd in anyway! Not that i can clearly see! but find and replace could be my friend!

Any idea on the naming of the documents and whether it can be done?

[gmayor]

Whether you can name the document from the contents depends on whether there is something common to each document that can be readily identified.
Was the large document created from mail merge, as that would make splitting and naming much simpler as mail merge defines each 'document' with a section break, and there is some commonality of layout to aid naming.

[Kilroy]

This code I pieced together seems to work. It separates based on page breaks. It asks for each file a "save as". I'm sure the professionals here could streamline it.

Sub Split1()
Dim arr() As Variant
Dim i As Byte
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
arr = Array("^b", "^m", "^n")
  For i = LBound(arr) To UBound(arr)
    With Selection.Find
      .Text = arr(i)
      .Replacement.Text = "//kilroy//"
      .Forward = True
      .Wrap = wdFindContinue
    End With
  Selection.Find.Execute Replace:=wdReplaceAll
  Next
Call Split2
End Sub
Sub Split2()
    SplitNotes "//kilroy//"
End Sub
Sub SplitNotes(strDelimiter As String)
    Dim oDoc As Document
    Dim arrNotes() As String, arrTitles() As String
    Dim lngIndex As Long, lngNum As Long
    Dim strTitle As String
    Dim oRng As Word.Range
    arrNotes = Split(ActiveDocument.Range, strDelimiter)
    For lngIndex = 0 To UBound(arrNotes)
        ReDim Preserve arrTitles(lngIndex)
        arrTitles(lngIndex) = Right(arrNotes(lngIndex), Len(arrNotes(lngIndex)) - InStrRev(arrNotes(lngIndex), " "))
    Next lngIndex
     
    If MsgBox("This will split the document into " & UBound(arrNotes) + 1 & " sections. Do you wish to proceed?", vbYesNo) = vbNo Then Exit Sub
    For lngIndex = LBound(arrNotes) To UBound(arrNotes)
        If Trim(arrNotes(lngIndex)) <> "" Then
            Set oDoc = Documents.Add
            oDoc.Range = arrNotes(lngIndex)
            On Error Resume Next
            strTitle = arrTitles(lngIndex)
            If Err.Number = 0 Then
                Set oRng = ActiveDocument.Range
                oRng.Collapse wdCollapseEnd
                oRng.MoveStart wdWord, -1
                oRng.Delete
                oDoc.SaveAs ThisDocument.Path & "\" & strTitle
            Else
                lngNum = lngNum + 1
                oDoc.SaveAs ThisDocument.Path & "\" & "Misc " & Format(lngNum, "000")
            End If
            oDoc.Close True
        End If
    Next lngIndex
End Sub

[Kilroy]

Guys I have 2 Questions:

1. How could I modify the above code to just automatically save the documents created instead of going through the "save as" dialogue? Is keeping them open an option?
2. Close the original document without saving?

[gmayor]

The code does not display the saveas diallog. It uses the saveas VBA function to save the document
To close the original document name the document e.g as oSource then close oSource e.g. as follows
I have not tested your code!

Sub SplitNotes(strDelimiter As String)
    Dim oDoc As Document
    Dim oSource As Document
    Dim arrNotes() As String, arrTitles() As String
    Dim lngIndex As Long, lngNum As Long
    Dim strTitle As String
    Dim oRng As Word.Range
    
    Set oSource = ActiveDocument
    arrNotes = Split(oSource.Range, strDelimiter)
    For lngIndex = 0 To UBound(arrNotes)
        ReDim Preserve arrTitles(lngIndex)
        arrTitles(lngIndex) = Right(arrNotes(lngIndex), Len(arrNotes(lngIndex)) - InStrRev(arrNotes(lngIndex), " "))
    Next lngIndex
     
    If MsgBox("This will split the document into " & UBound(arrNotes) + 1 & " sections. Do you wish to proceed?", vbYesNo) = vbNo Then Exit Sub
    For lngIndex = LBound(arrNotes) To UBound(arrNotes)
        If Trim(arrNotes(lngIndex)) <> "" Then
            Set oDoc = Documents.Add
            oDoc.Range = arrNotes(lngIndex)
            On Error Resume Next
            strTitle = arrTitles(lngIndex)
            If Err.Number = 0 Then
                Set oRng = oSource.Range
                oRng.Collapse wdCollapseEnd
                oRng.MoveStart wdWord, -1
                oRng.Delete
                oDoc.SaveAs ThisDocument.Path & "\" & strTitle
            Else
                lngNum = lngNum + 1
                oDoc.SaveAs ThisDocument.Path & "\" & "Misc " & Format(lngNum, "000")
            End If
            oDoc.Close 0
        End If
    Next lngIndex
    oSource.Close 0
End Sub

[leecable]

Whether you can name the document from the contents depends on whether there is something common to each document that can be readily identified.
Was the large document created from mail merge, as that would make splitting and naming much simpler as mail merge defines each 'document' with a section break, and there is some commonality of layout to aid naming.

Managed to find and replace to insert a delimiter at the start of each new document, which is sorted. There is something common about all of the documents, they all contain a section of text called 'Title:' Which is identical in every document. Obviously the text after the heading is different in each. So, I would ideally like that to be the title of each saved document.

So I want it to split at the part where I have inserted the delimiter, and now pull the name of the title as the saved file name. Its got to be possible.


I have had a look into the code of your splitter -

With oDoc
.UpdateStylesOnOpen = False
NewDocPageSetUp oDoc
oDoc.SaveAs FileName:=pPath & pFileName & Format(i, "000") & pExt, FileFormat:=lngType
.Close wdDoNotSaveChanges
End With

So I am guessing its to do with this part.

[leecable]

I have also managed to find this delightful piece of code

Sub GetRenameFiles() 
    Dim fd As FileDialog 
    Dim strFolder As String 
    Dim strFile As String 
    Dim aDoc As Document 
    Dim rngNewName As Range 
    Set fd = Application.FileDialog(msoFileDialogFolderPicker) 
    With fd 
        .Title = "Select the folder that contains the files." 
        If .Show = -1 Then 
            strFolder = .SelectedItems(1) & "\" 
        Else 
            MsgBox "You did not select a folder." 
            Exit Sub 
        End If 
    End With 
    strFile = Dir$(strFolder & "*.doc*") 
    While strFile <> "" 
        Set aDoc = Documents.Open(strFolder & strFile) 
        Set rngNewName = aDoc.Paragraphs(1).Range 
        rngNewName.MoveEnd wdCharacter, -1 
        aDoc.SaveAs2 rngNewName.Text 
        aDoc.Close 
        strFile = Dir$() 
    Wend 
End Sub

Which will basically name them the first line. Can I navigate to a specific line? As the Title is always on the same line on each page?

[leecable]

Cancel that, after scrolling down the document, it turns out that 'Title:' is not always in the same place within each individual document.

I'm also having issues with gregs splitter, in that its giving me 86 parts...of a document that's nearly 10000 pages long, this isn't correct

[Kilroy]

What is separating your documents? Give us a sample of a few pages. delete the content if need be. Just need the beginning and end of a few sections.

[leecable]

Ive got the documents splits, its just now the Save issue. I now have 800 files starting with notes 001, and so on.

[Kilroy]

Ok that's great. What is the code you used? I would be interested in seeing it.

[leecable]

So I used the original code I found,

Sub SplitNotes(delim As String, strFilename As String)
Dim doc As Document
Dim arrNotes
Dim I As Long
Dim X As Long
Dim Response As Integer
arrNotes = Split(ActiveDocument.Range, delim)
Response = MsgBox("This will split the document into " & UBound(arrNotes) + 1 & " sections.Do you wish to proceed?", 4)
If Response = 7 Then Exit Sub
For I = LBound(arrNotes) To UBound(arrNotes)
If Trim(arrNotes(I)) <> "" Then
X = X + 1
Set doc = Documents.Add
doc.Range = arrNotes(I)
doc.SaveAs ThisDocument.Path & "\" & strFilename & Format(X, "000")
doc.Close True
End If
Next I
End Sub
Sub test()
'delimiter & filename
SplitNotes "///", "Notes "
End Sub

Used the find and replace tool within word to insert my delimiter (delimit) into the document at the appropriate places. Which was swift. This then worked fine in splitting it. The issue is, I now have 800+ documents names Notes001.

[Kilroy]

what was the common separator for each doc?How did you put in the delimit?