Return word counts of multiple Word docs?

[MLulofs]

I'm a true newbie, so thanks in advance for your patience and help

I'm creating an Excel spreadsheet to display file properties for multiple projects. One of the properties I need to display is the total word count of all DOCs in a given folder. And I need that to be automated, as we're talking about hundreds of documents. So, in short, here's what I need to happen

1. Open all Word docs in file folder X
2. Count words in each doc
3. Sum all counts
4. Return sum

Like I said, I am a rookie in this area, so any and all information, tips, suggestions, etc. would be extremely valuable to me. Thank you!

 

[Peter Hewett]

Hi MLulofs

Here's two chunk of code to get you going. One creates a list of all documents in a
folder (and subfolder if required), it then opens the file so that you can count whatever
you want counted.

Private mlngCharacters As Long
Private mlngCharactersWithSpaces As Long
Private mlngFarEastCharacters As Long
Private mlngLines As Long
Private mlngPages As Long
Private mlngParagraphs As Long
Private mlngWords As Long

Public Sub BatchCount()
Dim docToModify As Word.Document
Dim lngindex As Long

' Set the folder to search and type of file
With Application.FileSearch
.NewSearch
.LookIn = "c:\my documents\test\"
.SearchSubFolders = False
.FileName = "*.doc"
.FileType = msoFileTypeWordDocuments
If .Execute() > 0 Then
Application.ScreenUpdating = False
For lngindex = 1 To .FoundFiles.Count

Set docToModify = Documents.Open(.FoundFiles(lngindex), Visible:=False)
StatusBar = "Modifying: " & docToModify

' Count each documents statistics
AccumulateStatistics

' Save and close updated document
docToModify.Close wdSaveChanges
Next lngindex
Application.ScreenUpdating = True
Else
MsgBox "There are no files is the search path that match the search mask"
End If
MsgBox .FoundFiles.Count & " files modified!"
End With

' Display accumulated results
MsgBox "Pages: " & mlngPages & vbCr & _
"Paragraphs: " & mlngParagraphs & vbCr & _
"Lines: " & mlngLines & vbCr & _
"Words: " & mlngWords & vbCr & _
"Characters: " & mlngCharacters & vbCr & _
"Characters with spaces: " & mlngCharactersWithSpaces & vbCr & _
"Far east Characters: " & mlngFarEastCharacters
End Sub

Public Sub AccumulateStatistics()

' Get this documents totals to previous document totals
With ActiveDocument
mlngCharacters = mlngCharacters + .ComputeStatistics(wdStatisticCharacters)
mlngCharactersWithSpaces = mlngCharactersWithSpaces + _
.ComputeStatistics(wdStatisticCharactersWithSpaces)
mlngFarEastCharacters = mlngFarEastCharacters + _
.ComputeStatistics(wdStatisticFarEastCharacters)
mlngLines = mlngLines + .ComputeStatistics(wdStatisticLines)
mlngPages = mlngPages + .ComputeStatistics(wdStatisticPages)
mlngParagraphs = mlngParagraphs + _
.ComputeStatistics(wdStatisticParagraphs)
mlngWords = mlngWords + .ComputeStatistics(wdStatisticWords)
End With
End Sub

If this does not quite do what you want you should be able to modify it.

HTH + Cheers - Peter

 

[MLulofs]

Holy Cow! What great help! Thanks very much, Peter

-Matt