Splitting a Large Word File Into Separate Files

[Grad student]

Hello. I do not know much about VBA or macros. I found the following on this site for splitting a Word document and it is wonderful:

Option Explicit

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 .
~Oorang

However, I need one that names each new file by the first line of text within each section. I saw another thread on this forum where it seemed very similiar. That person wrote:

Setting FIle Name when splitting document
I have a large word mail merge file that contains 3000 or so letters (all 1 page), I have code to split and save the document but need to change the line of code that sets the file name to be the first line of text in the letter.

This line references an employee number I need to set it as the file name so that the documents can be filed/ scanned.

The code at the moment is

strNewFileName = Replace(docMultiple.FullName, ".doc", "_" & Right$("000" & iCurrentPage, 4) & ".doc")

I would prefer to keep the first formula because I have sectioned off my original large documents with (///). But if anyone knows a formula to help me, I would greatly appreciate it. Thank you.

[Nelviticus]

What do you mean by 'the first line of text'? The following code (a modified version of what you posted) will use the first paragraph as the file name, limited to 20 characters:
Sub SplitNotes(delim As String)
Const MAXLENGTH As Long = 20
Dim doc As Document
Dim arrNotes
Dim I As Long
'Dim X As Long
Dim Response As Integer
Dim strFileName As String

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)
strFileName = doc.Paragraphs(1).Range.Text
If Len(strFileName) > MAXLENGTH Then
strFileName = Trim(Left(strFileName, MAXLENGTH))
End If
doc.SaveAs ThisDocument.Path & "\" & strFileName '& Format(X, "000")
doc.Close True
End If
Next I
End Sub


Sub test()
' delimiter & filename
SplitNotes "///"
End Sub
If you want more than 20 characters, modify the MAXLENGTH constant. If you want numbers appended to the file name (might be a good idea otherwise you could get identical file names), un-comment the three bits I commented out.

Regards

[Grad student]

The Word files I'm working with have the first and third lines looking like this (example):

November 16, 2001, Friday

PENROSELAND

or maybe:

December 28, 2001, Friday

CURTAIN CALLS, STAGE FRIGHTS



It would be nice if there was a macros/script/formula that would split apart the large file by section (marked with ///) and pull from these first and third lines and use this content as the file's name. So, pretending the above examples were in one big document, it would create (2) files named:



November 16, 2001, Friday PENROSELAND.doc
December 28, 2001, Friday CURTAIN CALLS, STAGE FRIGHTS.doc



Thank you again for your time and attempt to help me out.

[Nelviticus]

This is a minor modification to the above - the main change is the line that previously read 'strFileName = doc.Paragraphs(1).Range.Text':
Public Sub SplitDoc()
Const MAXLENGTH As Long = 20
Const DELIM As String = "///"
Dim doc As Document
Dim arrNotes
Dim I As Long
Dim Response As Integer
Dim strFileName As String

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
Set doc = Documents.Add
doc.Range = arrNotes(I)
strFileName = Trim(doc.Paragraphs(1).Range.Text)
If doc.Paragraphs.Count > 2 Then
strFileName = strFileName & " " & doc.Paragraphs(3).Range.Text
End If
If Len(strFileName) > MAXLENGTH Then
strFileName = Trim(Left(strFileName, MAXLENGTH))
End If
doc.SaveAs ThisDocument.Path & "\" & strFileName
doc.Close True
End If
Next I
End Sub