RE: Word/Character Count for a Group of Documents

To: Brian Smith,

'
' Macro: CountWordsCharactersInFolder
' This macro opens all the "Doc" files
' in a folder and places the file's name,
' word count, and character count in a table
' in the active document.
'
Sub CountWordsCharactersInFolder()
Dim sPath As String
Dim sActivePath As String
Dim sFileName As String
Dim newDoc As Document
Dim oRange As Range
Dim oTable As Table
Dim oRow As Row
'
' Make sure we're not puting a table inside another table
'
Set oRange = Selection.Range
oRange.Collapse wdCollapseStart
oRange.Select
If Selection.Information(wdWithInTable) = True Then
MsgBox "Move Cursor out of the table."
Exit Sub
End If
'
' Hard code path here, or let sPath = "" to get path from user.
'
sPath = ""
If sPath = "" Then
With Dialogs(wdDialogCopyFile)
If .Display() <> -1 Then Exit Sub
sPath = .Directory
End With
End If

If Len(sPath) = 0 Then Exit Sub
If Asc(sPath) = 34 Then
sPath = Mid(sPath, 2, Len(sPath) - 2)
End If
'
' Make sure that the active document is not in the folder
' (It causes problems when one attempts to close it.)
'
sActivePath = ActiveDocument.Path & Application.PathSeparator
If sPath = sActivePath Then
MsgBox "This Document is in the selected folder."
Exit Sub
End If
'
' Create table
'
Set oTable = oRange.Tables.Add(Range:=oRange, NumRows:=1, NumColumns:=3)
Set oRow = oTable.Rows(1)
With oRow
.Cells(1).Range.Text = "File Names"
.Cells(2).Range.Text = "Word Counts"
.Cells(2).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
.Cells(3).Range.Text = "Character Counts"
.Cells(3).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
End With
'
' Find Files
'
sFileName = Dir(sPath & "*.doc")
While sFileName > ""
Set newDoc = Documents.Open(sFileName, Visible:=False)
Set oRows = oTable.Rows.Add
With oRows
.Cells(1).Range.Text = sFileName
.Cells(2).Range.Text = newDoc.Words.Count
.Cells(3).Range.Text = newDoc.Characters.Count
End With
newDoc.Close
sFileName = Dir
Wend
'
' Done
'
MsgBox "Done"
End Sub

Steven Craig Miller

"Brian Smith" wrote:

Does anyone know where I could find some VBA code that would help me extract
the word and character counts for a group of Word documents in a given
folder? Ideally, I would like to extract this information and have it go
directly into a new document (in a table preferably). The table would look
something like the following.

File Name Word Count Character Count
xx1.doc 5,204 25,000
xx2.doc 7,500 39,500
etc.

Thanks in advance for any help/pointers. I'm assuming others have had a
similar need in the past and someone has already solved this problem. By the
way, I'm using Word 2003 under XP both with SP2.

Brian



.

Relevant Pages

  • Re: Browse for Folder/Directory
    ... I'm running Excel X Service Release 1. ... Dim cf As Variant ... ' open finder choose folder dialog window ... Dim character As String ...
    (microsoft.public.mac.office.excel)
  • Re: Word/Character Count for a Group of Documents
    ... and character count in a table ... Dim sPath As String ... Dim sActivePath As String ... Dim oRow As Row ...
    (microsoft.public.word.vba.general)
  • Re: Open & process multiple worksheets then move them to different folder.
    ... > workfile.xls and when it is situated in so and so folder. ... Dim vFilename As Variant ... Dim sPath As String ... Dim lCount As Long ...
    (microsoft.public.excel.programming)
  • Re: Please Help for a macro reading files not in sequence
    ... Dim MyFile As Object ... Dim sPath As String ... Set oFSO = CreateObject ... The macro I wrote here down, reads the files in each folder and writes the ...
    (microsoft.public.excel.misc)
  • Re: DOC to TXT
    ... You can use FileSystemObject to browse files and folders in your specified folder, and use it to delete the document. ... Dim doc As Word.Document ... Dim fso, folder, subFolder, docFile ... Dim sPath As String ...
    (microsoft.public.word.vba.beginners)