Splitting out a Word Document using VBA

David,

Your question was answered five hours ago by Timothy Rylatt in response to your cross-post on Stack Overflow. https://stackoverflow.com/questions/78254295/splitting-out-a-word-document-using-vba

For cross-posting etiquette, please read: A Message to Forum Cross-Posters

https://www.excelguru.ca/content.php?184

Hello there,

I'm happy to hear it worked fine your issue might be related to how the macro is navigating through the document to find the "Data_Start" sections so I've proposed an update code you can access below:

Sub SplitDocumentByHeading() Dim doc As Document Dim rng As Range Dim sectionCount As Integer Dim sectionTitle As String Dim newDoc As Document Dim savePath As String

' Set the path where the new documents will be saved savePath = ThisDocument.Path & Application.PathSeparator

' Initialize variables Set doc = ActiveDocument Set rng = doc. Content sectionCount = 0

' Find the first "Data_Start" occurrence If rng. Find.Execute(FindText:="Data_Start") Then Do ' Get the section title (assuming it's in the line before "Data_Start") sectionTitle = rng. Previous(wdParagraph). Range.Text

' Increment section count sectionCount = sectionCount + 1

' Set range to the content between this "Data_Start" and the next one Set rng = doc. Range(rng. End, doc. Content.End) If rng. Find.Execute(FindText:="Data_Start") Then Set rng = doc. Range(rng. Start, rng. Start) Else Set rng = doc. Range(rng. Start, doc. Content.End) End If

' Copy the section content to a new document Set newDoc = Documents.Add doc. Range(rng. Start, rng. End - 1). Copy newDoc.Range.Paste

' Save the new document with a suffix and close it newDoc.SaveAs2 FileName:=savePath & "Section_" & sectionCount & "_" & Trim(sectionTitle) & ".docx" newDoc.Close False

' Move to the end of the current section rng. Collapse Direction:=wdCollapseEnd Loop While rng. Find.Execute(FindText:="Data_Start")

MsgBox "Document split completed." Else MsgBox "No 'Data_Start' found in the document." End If

' Clean up Set doc = Nothing Set rng = Nothing Set newDoc = Nothing End Sub

This approach should help ensure that each "Data_Start" section is processed and saved into separate documents as intended and like yourself I'm still new to VBA so don't worry!

I hope these following solutions have been of assistance and should you have anymore problems please do not hesitate to contact me again in the future.

Give back to the Community. Help the next person who has this issue by indicating if this reply solved your problem. Click Yes or No below.

Thankyou for your continued help with this, one issue I am running into now however is the following;

                 ' Copy the section content to a new document

                               Set newDoc = Documents.Add

this line here --> doc. Range(rng. Start, rng. End - 1). Copy

                               newDoc.Range.Paste

It is generating a Runtime error 4608, Value out of range??

Thankyou so much for the continued assistance!

Thankyou so much for putting this together for me however I did run into a small issue - it is only creating one output file? So th test document I am running this on is the following;

Info Line 1

Info Line 2

Data_Start

Data1

Data2

Data3

Data_Start

Data4

Data5

Data 6

Data_Start

Data7

Data8

Data9

However once the macro runs all I am getting is one document with the following;

Info Line 1

Info Line 2

Data_Start

Otherwise the macro works perfectly! Apologies, I am so new to this I am not sure where I should be looking to make appropriate alterations!

Thankyou

Hello there Daniel,

I hope today the following solutions I provide can help with your VBA issue:

You can begin with the following VBA approach:

1. Open your Word document containing the sections you want to split.
2. Press Alt + F11 to open the VBA Editor.
3. Insert a new module (Insert > Module) and paste the below code into the module window:

Sub SplitDocument() Dim doc As Document Dim rng As Range Dim sectionRange As Range Dim sectionCount As Integer Dim fileName As String Dim outputPath As String Dim newDoc As Document

' Set the output folder path outputPath = "C:\Path\To\Output\Folder" ' Change this to your desired output folder

' Open the source document Set doc = ActiveDocument

' Initialize section count sectionCount = 1

' Loop through the document to find and split sections For Each rng In doc. StoryRanges Set sectionRange = Nothing

' Check if the current range contains "Data_Start" If InStr(rng. Text, "Data_Start") > 0 Then Set sectionRange = rng. Duplicate sectionRange.Collapse Direction:=wdCollapseStart

' Move to the end of the section Do While InStr(sectionRange.Text, "Data_Start") = 0 And Not sectionRange.End = ActiveDocument.Range.End sectionRange.MoveEnd wdParagraph Loop

' Save the section as a new document If Not sectionRange Is Nothing Then ' Generate the file name fileName = outputPath & "Section_" & sectionCount & ".docx"

' Save the section as a new document Set newDoc = Documents.Add sectionRange.Copy newDoc.Range.Paste newDoc.SaveAs2 fileName newDoc.Close sectionCount = sectionCount + 1 End If End If Next rng

' Notify user MsgBox "Splitting complete. " & sectionCount - 1 & " sections saved to " & outputPath

' Clean up Set doc = Nothing Set rng = Nothing Set sectionRange = Nothing Set newDoc = Nothing End Sub

4. Modify the outputPath variable to point to your desired output folder.
5. Close the VBA Editor and run the SplitDocument macro (Alt + F8, select SplitDocument, and click Run).

I hope these steps solved your issue however should you have anymore problems/concerns please do not hesitate to contact me again.

Thanks,

Parth P.