Splitting a word document using VBA

benjaminleschke

New Member
Joined
May 10, 2016
Messages
8
Hi, I have a word document that has three parts. Part 1 - first page is meeting information. Part 2 - 25 agenda items for my meetings. Part 3 - digital signature of approval. After each meeting I manually create 25 documents with Part 1, a single item in Part 2, and then Part 3. I repeat this process until I have 25 separate documents.

I am after some assistance in setting some section breaks and tagging to then add some VBA code or macro to automatically split the document for me.

Any assistance or advice is welcome. Thanks in advance.
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Ideally, you'd have Section breaks between all the parts and agenda items from the outset. Assuming you have Section breaks between all the parts and agenda items, you could then use a macro like:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim DocSrc As Document, DocTgt As Document, Rng As Range, i As Long
Set DocSrc = ActiveDocument
With DocSrc
  For i = 2 To .Sections.Count - 1
    Set DocTgt = Documents.Add(DocSrc.FullName)
    DocTgt.Range.FormattedText = .Sections.First.Range.FormattedText
    DocTgt.Characters.Last.FormattedText = .Sections(i).Range.FormattedText
    DocTgt.Characters.Last.FormattedText = .Sections.Last.Range.FormattedText
    DocTgt.Fields.Update
  Next
End With
Application.ScreenUpdating = True
End Sub
This would result in as many documents being generated as you have agenda items, with all documents having Parts 1 & 3 and the relevant agenda item from Part 2 between them.
 
Upvote 0
Thanks Paul. This works perfectly. Is there a way to use the same code provided, however update is so it auto names and auto saves the documents in the same location as the original?

The naming convention I want to use is in taken from two places in the original document.
The First is the agenda item name - the line after each section break has this
The second is the original file name. For example.

The document is called ' - Meeting 01 DD MMM YYYY'
The first agenda item is called '00123456 - Smith, John'

The first agenda item also has a bullet number in the front which I want to ignore when I name the file. In this case the 2.1.1 needs to be ignored: '2.1.1 00123456 - Smith, John'
Note that every agenda item name (all in part 2 of the document) will start with a '00'

In the example above I am hoping for the document created to be saved in the same folder as the original and named: '00123456 - Smith, John - Meeting 01 DD MMM YYYY'

Thanks in advance
 
Upvote 0
Try:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim DocSrc As Document, DocTgt As Document, Rng As Range, i As Long
Dim StrPth As String, StrANm As String, StrPfx As String, FlFmt As Long
Set DocSrc = ActiveDocument
With DocSrc
  StrPth = .Path & "\"
  StrANm = .Name
  FlFmt = .SaveFormat
  For i = 2 To .Sections.Count - 1
    Set DocTgt = Documents.Add(DocSrc.FullName)
    DocTgt.Range.FormattedText = .Sections.First.Range.FormattedText
    DocTgt.Characters.Last.FormattedText = .Sections(i).Range.FormattedText
    DocTgt.Characters.Last.FormattedText = .Sections.Last.Range.FormattedText
    StrPfx = "00" & Split(Split(.Sections(i).Range.Paragraphs(1).Range.Text, vbCr)(0), "00")(1)
    With DocTgt
      .Fields.Update
      .SaveAs2 FileName:=StrPth & StrPfx & " - " & StrANm, FileFormat:=FlFmt, AddToRecenetFiles:=False
      .Close False
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
Thanks Paul,

I tried that, it created document 1 (didn't save) and then failed with 'Run-time error '9': Subscript out of range.

The other documents weren't generated following the error.

Would it help if I upload a deidentified template?

Benjamin
 
Upvote 0
That suggests a paragraph like '2.1.1 00123456 - Smith, John' isn't the first thing that follows the Section break. If you have one or more empty (or not) paragraphs before that line, the code would need to be changed. For the second paragraph, you'd change:
StrPfx = "00" & Split(Split(.Sections(i).Range.Paragraphs(1).Range.Text, vbCr)(0), "00")(1)
to:
StrPfx = "00" & Split(Split(.Sections(i).Range.Paragraphs(2).Range.Text, vbCr)(0), "00")(1)
but clearly, you have to be consistent in what you do, as the code is very specific about what it expects to find wherever it looks.

It occurs to me also that you might not get the results you expect if there is more than one pair of '00' in the agenda item name.

As for uploading files, you can't do that here.
 
Last edited:
Upvote 0
Thanks Paul, I think I may have identified my error; there are actually 4 parts to the document. The agenda items start at part 3; not 2.

I have a draft (de-identified) document for you to condsider if you wouldn't mind. I have noted the parts of the documents in the headers. I still get the error.

My email is <email address>

I wasn't sure how to attach the document; I am new to this forum.


Cheers
Benjamin
 
Last edited by a moderator:
Upvote 0
I assume that means you have a Section break between parts 1 & 2. In that case, you can either:
• delete the Section break between those parts; or, if that's not feasible
• change:
For i = 2 To .Sections.Count - 1
to:
For i = 3 To .Sections.Count - 1
and, if all documents need part 2, insert:
DocTgt.Characters.Last.FormattedText = .Sections(2).Range.FormattedText
after:
DocTgt.Range.FormattedText = .Sections.First.Range.FormattedText
 
Upvote 0
Thanks for your assistance Paul. This is now working on my template. I will build this up and try it with a full set of minutes.

Once again, appreciate your help and perseverence with me! :)
 
Upvote 0

Forum statistics

Threads
1,213,535
Messages
6,114,192
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top