I posted a macro to do this last time you asked about it. That macro put the
word count in a message box. If you want it in a document then see below. I
have also put in the same count routine that David Sissons offered, though
it gives the same answers. Neither counts text in the header/footer. The
macro will close (giving you the opportunity to save) any open documents
before running on the folder you select. This does work in Word 2007 or
2003.
Sub Test2()
Dim myFile As String
Dim PathToUse As String
Dim MyDoc As Document
Dim wdCount As Integer
Dim docCount As Integer
wdCount = 0
docCount = 0
With Dialogs(wdDialogCopyFile)
If .Display <> 0 Then
PathToUse = .Directory
Else
MsgBox "Cancelled by User"
Exit Sub
End If
End With
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
If Left(PathToUse, 1) = Chr(34) Then
PathToUse = Mid(PathToUse, 2, Len(PathToUse) - 2)
End If
myFile = Dir$(PathToUse & "*.do*")
While myFile <> ""
Set MyDoc = Documents.Open(PathToUse & myFile)
docCount = docCount + 1
'wdCount = wdCount + MyDoc.BuiltInDocumentProperties(wdPropertyWords)
wdCount = wdCount + MyDoc.ComputeStatistics(Statistic:=wdStatisticWords, _
IncludeFootnotesAndEndnotes:=True)
MyDoc.Close SaveChanges:=wdDoNotSaveChanges
myFile = Dir$()
Wend
Documents.Add
Selection.TypeText wdCount & " in " & docCount & " documents"
End Sub
--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP
My web site
www.gmayor.com
Word MVP web site
http://word.mvps.org
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Jan Kratochvil wrote:
> I have this macro but some funcionality is deprecated for W2007.
> Have you any suggestion how to make it in other way?
>
>
> Sub CountAllWords()
> '2007 David Sisson
> ' not suported for W2007 Application.FileSearch deprecated
> Dim aDoc As Document
> Dim bDoc As Document
> Dim sFolderToLookIn As String
> Dim TotalWords As Integer
> Dim DocWordsCount As Integer
> Dim X As Integer
>
> Set bDoc = ActiveDocument
> sFolderToLookIn = "C:\My Documents\CountingFolder"
> With Application.FileSearch
> .NewSearch
> .FileName = "*.doc"
> .LookIn = sFolderToLookIn
> .Execute
> For X = 1 To .FoundFiles.Count
> Application.ScreenUpdating = False
> Set aDoc = Documents.Open(.FoundFiles(X))
> DocWordsCount =
> aDoc.ComputeStatistics(Statistic:=wdStatisticWords, _
> IncludeFootnotesAndEndnotes:=True)
>
> bDoc.Range.InsertAfter .FoundFiles(X) & " - " & DocWordsCount
> & vbCr TotalWords = TotalWords + DocWordsCount
> aDoc.Close savechanges:=wdDoNotSaveChanges
> Next X
>
> bDoc.Range.InsertAfter TotalWords & " Total words in " & X &
> "documents." End With
> Application.ScreenUpdating = True
> End Sub