How to split word files by the number of characters - ms-word

Question

Could you anybody help me how to split word file by character!
I can't find any way to split word files by the number of characters on the internet!

Answer 1

For example, to split a document into 500-character blocks:
Sub SplitDocument()
Application.ScreenUpdating = False
Dim Rng As Range, i As Long, j As Long
Const Char As Long = 500
With ActiveDocument
' Process each character block
For i = 1 To Int(.Characters.Count / Char)
j = j + 1
' Get the character block
Set Rng = .Range((i - 1) * Char, i * Char)
' Copy the character block
Rng.Copy
Rng.Collapse wdCollapseEnd
Call NewDoc(ActiveDocument, (i - 1) * Char + 1, j)
Next
If Rng.End < .Range.End Then
i = i + 1: j = j + 1
Rng.End = .Range.End
' Copy the range
Rng.Copy
Rng.Collapse wdCollapseEnd
Call NewDoc(ActiveDocument, (i - 1) * Char + 1, j)
End If
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub
Sub NewDoc(DocSrc As Document, i As Long, j As Long)
Dim DocTgt As Document, HdFt As HeaderFooter
' Create the output document
Set DocTgt = Documents.Add(Visible:=False)
With DocTgt
' Paste contents into the output document, preserving the formatting
.Range.PasteAndFormat (wdFormatOriginalFormatting)
' Replicate the headers & footers
For Each HdFt In DocSrc.Sections(DocSrc.Characters(i).Sections(1).Index).Headers
.Sections(1).Headers(HdFt.Index).Range.FormattedText = HdFt.Range.FormattedText
Next
For Each HdFt In DocSrc.Sections(DocSrc.Characters(i).Sections(1).Index).Footers
.Sections(1).Footers(HdFt.Index).Range.FormattedText = HdFt.Range.FormattedText
Next
' Save & close the output document
.SaveAs FileName:=Split(DocSrc.FullName, ".doc")(0) & "_" & j & ".docx", _
FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
.Close SaveChanges:=False
End With
Set DocTgt = Nothing: Set DocSrc = Nothing
End Sub