Microsoft Office Forums - View Single Post - [Solved] Splitting word doc into batches of 1000 words

macropod · 07-07-2018, 03:56 PM

Try something along the lines of:

Code:

Sub Splitter()
Dim DocSrc As Document, DocTgt As Document, i As Long, j As Long, Rng As Range, StrTgt As String
Set DocSrc = ActiveDocument
With DocSrc
  Set Rng = .Range(0, 0): j = 1000: StrTgt = Split(.FullName, ".doc")(0) & "_"
  For i = 1 To -Int(-.ComputeStatistics(wdStatisticWords) / j) 
    If .Range(Rng.Start, .Range.End).ComputeStatistics(wdStatisticWords) < j Then _
      j = .Range(Rng.Start, .Range.End).ComputeStatistics(wdStatisticWords)
      If j = 0 Then Exit For
    With Rng
      .MoveEnd wdWord, j
      .End = .Paragraphs.Last.Range.End
      Do While .ComputeStatistics(wdStatisticWords) < j
        .MoveEnd wdParagraph, wdForward
      Loop
      Set DocTgt = Documents.Add(Template:=DocSrc.AttachedTemplate.FullName, Visible:=False)
      With DocTgt
        .Range.FormattedText = Rng.FormattedText
        .SaveAs2 StrTgt & i & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
        .Close False
      End With
      .Collapse wdCollapseEnd
      If .End = DocSrc.Range.End Then Exit For
    End With
  Next
End With
End Sub

The macro outputs each split to a new document, with the split occurring at the end of whichever paragraph has the 1000th word in the current block.

Any document you run the code on will be split into ~1000 word segments. It's a once-off exercise, though and, if you need to make further splits, re-running the macro will simply regenerate the previous splits (subject to any edits you've made there).

For PC macro installation & usage instructions, see: Installing Macros
For Mac macro installation & usage instructions, see: https://wordmvp.com/Mac/InstallMacro.html