Word Count on over 7000 word docs

[Sujal]

How can I extract word count of over 7000 word docs and place the answer in
Excel.

Also need to get the word count of the doc into the doc, how can I do that
automatically for over 7000 docs?

Thanks

Sujal

 

[Doug Robbins - Word MVP]

The following will create a new document containing the information that you
can then copy and paste into Excel. It will however include punctuation
marks, etc. in the count:

Dim MyPath As String
Dim MyName As String
Dim source As Document
Dim target As Document
Dim Wordcount As Long

Set target = Documents.Add

'let user select a path
With Dialogs(wdDialogCopyFile)
If .Display() <> -1 Then Exit Sub
MyPath = .Directory
End With

'strip quotation marks from path

If Len(MyPath) = 0 Then Exit Sub

If Asc(MyPath) = 34 Then
MyPath = Mid$(MyPath, 2, Len(MyPath) - 2)
End If

'get files from the selected path
'and insert them into the doc
MyName = Dir$(MyPath & "*.*")
Do While MyName <> ""
Set source = Documents.Open(MyName)
Wordcount = source.Words.Count
source.Range.InsertAfter vbCr & "This document contains " & Wordcount &
" words (including punctuation and paragraph marks)."
target.Range.InsertAfter "The document " & MyName & " contains " &
Wordcount & " words (including punctuation and paragraph marks)." & vbCr
source.Save
source.Close
MyName = Dir
Loop
target.Activate

If you want to exclude punctuation and paragraph marks, the following should
do that, but will take a lot longer:

Dim MyPath As String
Dim MyName As String
Dim source As Document
Dim target As Document
Dim Wordcount As Long

Set target = Documents.Add

'let user select a path
With Dialogs(wdDialogCopyFile)
If .Display() <> -1 Then Exit Sub
MyPath = .Directory
End With

'strip quotation marks from path

If Len(MyPath) = 0 Then Exit Sub

If Asc(MyPath) = 34 Then
MyPath = Mid$(MyPath, 2, Len(MyPath) - 2)
End If

'get files from the selected path
'and insert them into the doc
MyName = Dir$(MyPath & "*.*")
Do While MyName <> ""
Set source = Documents.Open(MyName)
Wordcount =
source.Content.ComputeStatistics(Statistic:=wdStatisticWords,
IncludeFootnotesAndEndnotes:=True)
source.Range.InsertAfter vbCr & "This document contains " & Wordcount &
" words."
target.Range.InsertAfter "The document " & MyName & " contains " &
Wordcount & " words." & vbCr
source.Save
source.Close
MyName = Dir
Loop
target.Activate


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[Sujal]

Thanks Doug! This solved the problem.

Thank again for your help!

Sujal