[Jan Kratochvil]

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

--
Regards
Jan Kratochvil
WIN XP Pro SP2, Office 2007

[Graham Mayor]

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:=wdStatisticWord s, _
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

[Jan Kratochvil]

I inserted the macro in my template but I can't get the Msg Box with result.

Here is the test template I tried to use:
http://www.flashmedia.cz/test/test_tpl.dot

The macro did following:

It opens directory
I select directory and click open
Document will be closed.
Than nothing happen.
I can't see the Msg Box.

Thank you




--
Regards
Jan Kratochvil
WIN XP Pro SP2, Office 2007


"Graham Mayor" wrote:

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:=wdStatisticWord s, _
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

[Graham Mayor]

The version of the macro (test2) in this thread writes the count to a new
document.
The earlier one wrote it to a message box.
If you put your template from the web link in the startup folder for Word
2007 m(or open it in Word 2007, to make its macros available, it works as
stated. It opens every document in the selected folder and counts the
documents and the words in them.

--

Graham Mayor - Word MVP

My web site www.gmayor.com
Word MVP web site http://word.mvps.org


Jan Kratochvil wrote:
I inserted the macro in my template but I can't get the Msg Box with
result.

Here is the test template I tried to use:
http://www.flashmedia.cz/test/test_tpl.dot

The macro did following:

It opens directory
I select directory and click open
Document will be closed.
Than nothing happen.
I can't see the Msg Box.

Thank you





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:=wdStatisticWord s, _
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