Filename after splitting document

[Julian]

hey everybody, I have a big word document that I want to split automaticly into a large number of smaller documents. I found this code below, that works perfectly. I just have one question. The code names the new documents Notes1, Notes2, Notes3 ect. but I would like to give them the respective first text line in the document (always 6 words) as document titles.
Is that possible and if yes, how do I have to change the code?
Thank you very much for your help!!!

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 "XXX", "Notes "
End Sub

[gmayor]

Maybe something like. I left in the numbering.

Option Explicit

Sub SplitNotes(delim As String)
Dim doc As Document
Dim arrNotes As Variant
Dim strPath As String
Dim strFilename As String
Dim I As Long
Dim X As Long
Dim oPara As Range
Dim Response As Integer
    ActiveDocument.Save
    strPath = ActiveDocument.Path
    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(Template:=ActiveDocument.FullName)
            doc.Range = arrNotes(I)
            Set oPara = doc.Paragraphs(1).Range
            oPara.End = oPara.End - 1
            strFilename = oPara.Text & Chr(32)
            doc.SaveAs strPath & "\" & strFilename & Format(X, "000")
            doc.Close True
        End If
    Next I
lbl_Exit:
    Set doc = Nothing
    Exit Sub
End Sub
Sub test()
'delimiter
    SplitNotes "XXX"
End Sub

[Julian]

Thank you very much for the quick reply!!!

I tried the code and it is on a good way. For the first document that it creates it works, but unfortunately only for the first dokument. All other documents were just numbered but didn't had the first line as document title.

Any ideas?

thank you very much for your support!

[macropod]

See the Split Merged Output to Separate Documents topic in the Mailmerge Tips and Tricks 'Sticky' thread, at:
https://www.msofficeforums.com/mail-...ps-tricks.html

[Julian]

Thank you for your help. The code that you provided splits the document by sections, but I need to split it by a delimiter. I tried to combine the two codes but I just don't get it work

Do you know how I would have to edit my original code (see above) to save the documents with the first textline as FileNames, OR how I would have to edit your code the split the documents by a delimiter?

[macropod]

Graham's macro works correctly for the scenario you described. Evidently, though, your notes do not always have meaningful content as the first paragraph. Indeed, your description in post #3 suggests only the first note is formatted as you described.

The macro in the link I gave you also shows how to get the first paragraph's text, but adds processing to remove any illegal filename characters before trying to save. You could incorporate however much of that process you want into your original code. The other difference between my filename code and Graham's is that his also adds the Note # to the filename. Of course, all of this is moot if your notes don't conform to your specifications.