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

Guessed · 07-13-2018, 06:33 PM

Alex

I was finding Paul's code a bit too complex so I had a go with a different approach which seems to work. Paul's approach of jumping 1000 words removes the iteration of my approach (and probably works faster) but I thought it was simpler to increment by paragraph until we pass the limit.

Code:

Sub Splitter2()
  Dim DocSrc As Document, DocTgt As Document
  Dim lDocLength As Long, i As Long, j As Long, aRng As Range, StrTgt As String

  Set DocSrc = ActiveDocument
  lDocLength = DocSrc.Range.End - 2
  StrTgt = Split(DocSrc.FullName, ".doc")(0) & "_"
  Set aRng = DocSrc.Paragraphs(1).Range
  Do Until aRng.End > lDocLength
    i = i + 1
    Do Until aRng.ComputeStatistics(wdStatisticWords) > 1000 Or aRng.End > lDocLength
      aRng.MoveEnd Unit:=wdParagraph, Count:=1
    Loop
    Set DocTgt = Documents.Add(Template:=DocSrc.FullName, Visible:=False)
    DocTgt.Range.FormattedText = aRng.FormattedText
    DocTgt.SaveAs2 StrTgt & i & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
    DocTgt.Close False
    aRng.Collapse Direction:=wdCollapseEnd
  Loop
  MsgBox "Saved doc count: " & i
End Sub

I would predict all sorts of confusion if a breakpoint arrives in the middle of a table but I haven't done testing for that.