Split doc into multi documents- the string becomes the file names

[gentle]

Hi
Not sure if you can help.
But I have NO knowledge of macros . Just know how to past the info in.

I am looking for a macro that splits the doc into multi documents.
NEED it to finds red letters or a delimiter .
The red-letter string becomes the filename, so the importer can then create a topic(filename) from it and keep the original layout.


Would like the option to save in rtf. (maybe have one doc. and one for rtf.

I have found the following that was submitted by Lucas

It works very well but does not keep the original font sizes that was in my documents setup and saves files in number list (001, 002 etc).


Put this code In a standard module:
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





I have found this one but it saves per page and uses the original document name (Sorry not sure where I got it to give credit.).

Option Explicit 'This goes in the Declarations section of your code module.
'Hopefully it is already there because you have ticked the 'Require Variable Declaration' _
checkbox. (Tools/Options, Editor tab.)


Sub SplitIntoPages()
Dim docMultiple As Document
Dim docSingle As Document
Dim rngPage As Range
Dim iCurrentPage As Integer
Dim iPageCount As Integer
Dim strNewFileName As String

Application.ScreenUpdating = False 'Makes the code run faster and reduces screen _
flicker a bit.
Set docMultiple = ActiveDocument 'Work on the active document _
(the one currently containing the Selection)
Set rngPage = docMultiple.Range 'instantiate the range object
iCurrentPage = 1
'get the document's page count
iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages)
Do Until iCurrentPage > iPageCount
If iCurrentPage = iPageCount Then
rngPage.End = ActiveDocument.Range.End 'last page (there won't be a next page)
Else
'Find the beginning of the next page
'Must use the Selection object. The Range.Goto method will not work on a page
Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1
'Set the end of the range to the point between the pages
rngPage.End = Selection.Start
End If
rngPage.Copy 'copy the page into the Windows clipboard
Set docSingle = Documents.Add 'create a new document
docSingle.Range.Paste 'paste the clipboard contents to the new document
'remove any manual page break to prevent a second blank
docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:=""
'build a new sequentially-numbered file name based on the original multi-paged file name and path
strNewFileName = Replace(docMultiple.FullName, ".doc", "_" & Right$("000" & iCurrentPage, 4) & ".doc")
docSingle.SaveAs strNewFileName 'save the new single-paged document
iCurrentPage = iCurrentPage + 1 'move to the next page
docSingle.Close 'close the new document
rngPage.Collapse wdCollapseEnd 'go to the next page
Loop 'go to the top of the do loop
Application.ScreenUpdating = True 'restore the screen updating

'Destroy the objects.
Set docMultiple = Nothing
Set docSingle = Nothing
Set rngPage = Nothing
End Sub



Thank you in advance.

[Tinbendr]

Welcome to VBA Express!

We're not going to be able help you until you upload a sample document.

David

[fumei]

And you need to be very explicit about what you want to happen.

"I am looking for a macro that splits the doc into multi documents.
NEED it to finds red letters or a delimiter . "

Split HOW? By red letters? By a delimiter? Which?

By "red letters" do you mean:

1. start from the beginning of the document;
2. find the first string of red letters
3. make a document from the start to the red letters/

OK. Does that mean include the red letters? NOT include them?

And on and on. You must think it out fully. What, exactly, do you want to happen. As Tinbendr suggest, it would also help us immensely if you can post a sample document, and clearly state what result you want.

[gentle]

Hi


I have tried to explain better.

This is what I want

1.Split document with many sections in individual documents.
Split HOW? By red letters? By a delimiter? Which?

2.It can be split with delimiter (or any other way but not sure what would be the best).
Please see sample : each section I choose must become a document (Have included an sample).

3. It must be saved using the heading for the chapter (but it is not a header 1).

4. must be save looking like the original.

5.They must be saved as an rtf.




By "red letters" do you mean:

1.start from the first set of red letters until the next set Do Not included the second set of words in the first document.

2.The second set of red words will be the beginning of the second document

3.And so it will continue to create the rest of the documnets repeating it every time.




NO 1

When I use this one I have to put /// as the delimiter.
And it saves with the file name Notes 001, Notes 002 etc (SAMPLE INCLUDED)

Instead of the word Notes I would like the words in red in the main document to be the file name.
Example: I. Definition 001.rtf
(the words don’t have to be red just an indication to show you)

The fonts have changed from what they were (would like it to be like the original)

It saves it in C:\Users\gentle\AppData\Roaming\Microsoft\Templates.


Option Explicit

Sub SplitNotes(delim As String, strFilename As String)
Dim rtf 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 rtf = Documents.Add
rtf.Range = arrNotes(i)
rtf.SaveAs ThisDocument.Path & "\" & strFilename & Format(x, "000")
rtf.Close True
End If
Next i
End Sub


Sub SplitNotes_Delimiter_Filename_rtf()
' delimiter & filename
SplitNotes "///", "Notes "
End Sub

This came from the this site (Lucas)

[gentle]

Go to thread: Need macro to split large word doc by headings
posted by philkp

The answer has been posted there except it is not done with red letters but with 'header 1' .




Thank you Tinbendr :clap2:you answered my question by answering the other post