Skip to main content
Support is Offline
Today is our off day. We are taking some rest and will come back stronger tomorrow
Official support hours
Monday To Friday
From 09:00 To 17:30
  Thursday, March 28, 2024
  2 Replies
  4.1K Visits
Hi,
According to this post
https://www.extendoffice.com/documents/word/5415-split-word-document-every-x-pages.html#a1
Please I want the same idea but with word count
So I want to split a word document every 14000 words in the same folder.
Thanks
8 months ago
·
#8585
Thanks for your reply Amanda :)
I ran the VBA code, but it took a long time without any results (Not Responding)
The Word hangs and crashes and the fan over sound although I have a laptop with 16GB RAM, 256GB M.2 NVMe SSD, and 1TB HDD .
Thanks
8 months ago
·
#8584
Hi there,

We will certainly take your suggestion into consideration for inclusion in future versions of the feature! Thank you for your valuable input!

And, I've generated the below VBA code using Kutools AI Aide and tested it successfully. Please feel free to give it a try:

NOTE: Ensure you back up your document before executing this VBA script to safeguard against potential issues or to revert any changes if necessary.

Sub SplitDocumentEvery14000Words()
Dim originalDoc As Document
Set originalDoc = ActiveDocument

Dim wordCount As Long
wordCount = 0

Dim docIndex As Integer
docIndex = 1

Dim newDoc As Document
Set newDoc = Documents.Add

Dim originalDocPath As String
originalDocPath = originalDoc.Path

Dim i As Long
For i = 1 To originalDoc.Words.Count
wordCount = wordCount + 1
newDoc.Content.InsertAfter originalDoc.Words(i).Text

' Split and save every 14000 words
If wordCount >= 14000 Then
' Reset word count
wordCount = 0

' Save the document
newDoc.SaveAs2 FileName:=originalDocPath & "\SplitDoc_" & docIndex & ".docx"

' Prepare for next document
docIndex = docIndex + 1
Set newDoc = Documents.Add
End If
Next i

' Save the last document if it has content
If newDoc.Content.Words.Count > 1 Then
newDoc.SaveAs2 FileName:=originalDocPath & "\SplitDoc_" & docIndex & ".docx"
Else
newDoc.Close False
End If

MsgBox "Documents have been split successfully."
End Sub


Let me know if you encounter any issues or if there's anything else I can assist you with.

Amanda
  • Page :
  • 1
There are no replies made for this post yet.