Custom Word document splitter! VBA

[arvex]

Hello experts!

I have code by Jacob Hilderbrand:

Option Explicit 
 
Sub AllSectionsToSubDoc() 
     
    Dim x               As Long 
    Dim Sections        As Long 
    Dim Doc             As Document 
     
    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 
     
    Set Doc = ActiveDocument 
    Sections = Doc.Sections.Count 
    For x = Sections - 1 To 1 Step -1 
        Doc.Sections(x).Range.Copy 
        Documents.Add 
        ActiveDocument.Range.Paste 
        ActiveDocument.SaveAs (Doc.Path & "\" & x & ".doc") 
        ActiveDocument.Close False 
    Next x 
     
    Application.ScreenUpdating = True 
    Application.DisplayAlerts = True 
     
End Sub

All i want is to work code custom like:

Split document when 7th paragraph changes!

Document is like (might be different):

PAGE1

Text
Text
Text
Text
Text
Text
Text1
Text
Text

PAGE2

Text
Text
Text
Text
Text
Text
Text1
Text
Text

PAGE3

Text
Text
Text
Text
Text
Text
Text2
Text
Text

PAGE4

Text
Text
Text
Text
Text
Text
Text3
Text
Text

PAGE5

Text
Text
Text
Text
Text
Text
Text3
Text
Text

ETC

As a result from given example I want to see is 3 Word documents:

• 1st Word document all pages when Text1 is in paragraph 7;
• 2nd Word document all pages when Text2 is in paragraph 7;
• 3rd Word document all pages when Text3 is in paragraph 7;
• ETC...

And save each document by trimmed text from 1st page 7th and 3rd paragraph of new document (of whole document each page's 3rd paragraph is different)
Save for 1st document with Text1 would be: It's "Paragraph7_Paragraph3.docx"

 

[arvex]

Here is the link of base Word document and Excel database(made example). And outputs that i want to see! (in other folder)

https://failiem.lv/u/u7kmjfdw#_

 

[Macropod]

What is the point of the «Letter_number» mergefield and the corresponding Excel data? In a Directory merge, with multiple records, there is no single 'number' per letter. You also don't need the «Letter_Date» field and the corresponding Excel data if it's always today's date - Word can put that in on its own.

 

[arvex]

«Letter_number» is needed as document might be printed and sent in paper format which is registered by records Management. If talking about 'number' and file save, than I have posted the format in 1st post:

And save each document by trimmed text from 1st page 7th and 3rd paragraph of new document (of whole document each page's 3rd paragraph is different)
Save for 1st document with Text1 would be: It's "Paragraph7_Paragraph3.docx"

From my sent examples output with:
Student1 results would be "Student 1_1.docx";
Student2 results would be "Student 2_4.docx";
Student3 results would be "Student 3_7.docx";
...
The number is taken from output's 1st page.[FONT=&quot][/FONT]

 

[Macropod]

Try the document in the link: Student_letters_test - Download - 4shared - Paul Edstein

Simply save the file to the same folder as the workbook, connect it to the data source, then run the Merge_Student_Results_To_Individual_Files macro.

The document uses the «Student» mergefield plus two DATABASE fields, the first to retrieve the letter-number range, the second to build a table of the results.

The DATABASE fields are coded as:

{DATABASE \d "{FILENAME \p}/../Student_book_test.xlsx" \s " SELECT '4.4.M: ' & Min([Letter number]) & '-' & Max([Letter number]) FROM [Sheet1$] WHERE [Student] = '{MERGEFIELD Student}' "  \l 1 \b 1}

and:

{DATABASE \d "{FILENAME \p}/../Student_book_test.xlsx" \s " SELECT [Class], [Mark] as Result, FORMAT([Date], 'DD.MM.YYYY') AS [Exam Date] FROM [Sheet1$] WHERE [Student] = '{MERGEFIELD Student}' ORDER BY [Class] " \l 23 \b 180 \h}

The macro that drives the process is:

Sub Merge_Student_Results_To_Individual_Files()
Application.ScreenUpdating = False
Dim MainDoc As Document, StrFolder As String, StrName As String
Dim i As Long, r1 As Long, r2 As Long
Set MainDoc = ActiveDocument
With MainDoc
  StrFolder = .Path & Application.PathSeparator
  For i = 1 To .MailMerge.DataSource.RecordCount
    With .MailMerge
      .Destination = wdSendToNewDocument
      .SuppressBlankLines = True
      With .DataSource
        .FirstRecord = i
        .LastRecord = i
        .ActiveRecord = i
        r1 = .DataFields("Letter_number")
      End With
      If .DataSource.DataFields("Student") <> StrName Then
        StrName = .DataSource.DataFields("Student")
        .Execute Pause:=False
        With ActiveDocument
          r2 = .Tables(1).Rows.Count + r1 - 2
          .SaveAs2 FileName:=StrFolder & StrName & " " & r1 & "-" & r2 & ".docx", _
            FileFormat:=wdFormatDocumentDefault, AddToRecentFiles:=False
          .Close False
        End With
      End If
    End With
  Next i
End With
Application.ScreenUpdating = True
End Sub

 

[arvex]

This works brilliant!!! Thanks!!! But is it possible to have like Student 1 (and others) to have results each class with results and exam dates to different pages in one word document? Like i have given in output examples (link). I guess its not possible with multiple records or it is?

 

[Macropod]

Please clarify your requirements: you previously said you wanted one file per student, which is what I've provided, with all records on a single page. Your last post is quite unclear as to what you want. I can't see how your previous examples relate to your latest post.

 

[arvex]

Please clarify your requirements: you previously said you wanted one file per student, which is what I've provided, with all records on a single page. Your last post is quite unclear as to what you want. I can't see how your previous examples relate to your latest post.

Well Your work is really great and I will use it for sure. Also i have managed to get results I want aswell by changing in code by chaging

        .LastRecord 
        .ActiveRecord

Thanks again! (Also have changed a bit word document)

 

[arvex]

PS. just wanted to have result as in "Split output" folder.

 

[arvex]

Question!

[Mark] as Result

in Word

Im getting error if I want to insert dot like if I want

[Mark] as Result[B].[/B]

I want to have dot in column name!

 

[Macropod]

PS. just wanted to have result as in "Split output" folder.

I have no idea what you mean.