I need to Character Count multiple documents.

Question

So I have to get the character count (with spaces) from a ton of Word Documents and place them into an Excel sheet. To do this, I am opening the Word file, clicking the word count on the bottom, recording it into Excel, then closing and opening the next document to do it over again. I have to do this to over 300 documents. I'm wondering if there is a way to get this information in a more efficient way? I can't use the character count that you can get through the properties link in the File Explorer as it gives a different number.

Thank you in advance.

Answer 1

Running a macro with the following code will ask you to select the folder containing the files and then it will create a two column table in a new document into the first column of which it will insert the path and filename of each file in the folder and in the second column it will insert the number of characters with spaces that are in each document.

Sub getchars()

Dim FD As FileDialog

Dim DocSource As Document

Dim doctarget As Document

Dim tblTarget As Table

Dim tblrow As Row

Set FD = Application.FileDialog(msoFileDialogFolderPicker)

With FD

    .Title = "Select the folder that contains the documents."

    If .Show = -1 Then

        strFolder = .SelectedItems(1) & ""

    Else

        MsgBox "You did not select a folder."

        Exit Sub

    End If

End With

strFile = Dir$(strFolder & "*.doc*")

Set doctarget = Documents.Add

Set tblTarget = doctarget.Tables.Add(doctarget.Range, 1, 2)

With tblTarget

    .Cell(1, 1).Range.Text = "File Name"

    .Cell(1, 2).Range.Text = "Characters"

End With

While strFile <> ""

    Set DocSource = Documents.Open(strFolder & strFile)

    Set tblrow = tblTarget.Rows.Add

    With tblrow

        .Cells(1).Range.Text = DocSource.FullName

        .Cells(2).Range.Text = DocSource.Characters.Count - DocSource.Paragraphs.Count

    End With

    DocSource.Close wdDoNotSaveChanges

    strFile = Dir$()

Wend

doctarget.Activate

End Sub

Answer 2

Mr. Robbins,

I tried running your code but kept receiving a Run-time error '5174'. This happens in multiple folders with different docs. A new Word document does appear with File Name and Characters typed up but nothing else. The documents that it states as receiving this error are also found in the middle of my saved files. Also, the Continue button is grayed out.

When clicking on the Debug option it highlights the 

Set DocSource = Documents.Open(strFile) under the**While strFile <> ""**heading at the end of the code. When running my cursor over the highlighted bit it states that DocSource = Nothing and strFile = "documentname.doc". I am unsure if this is relevant but would like to put it in just in case.

Any thoughts?

Answer 3

What is the file extension on the files .docx or .doc?

If they are all the latter, remove the * form the line

strFile = Dir$(strFolder & "*.doc*")

If, all the former, replace the * with x

If there is a mixture, you may need to run the code twice, once with

strFile = Dir$(strFolder & "*.doc")

and then with

strFile = Dir$(strFolder & "*.docx")

Answer 4

Mr. Robbins,

All my files end if .doc. I have removed the * from the end of that line you have pointed out and am still receiving the same message. I got the same results from converting two files into .docx and trying the other code. 

Please advise.

Answer 5

Sorry, there was an error in the code.  

Use the following:

Sub getchars()

Dim FD As FileDialog

Dim DocSource As Document

Dim doctarget As Document

Dim tblTarget As Table

Dim tblrow As Row

Set FD = Application.FileDialog(msoFileDialogFolderPicker)

With FD

.Title = "Select the folder that contains the documents."

If .Show = -1 Then

strfolder = .SelectedItems(1) & ""

Else

MsgBox "You did not select a folder."

Exit Sub

End If

End With

strFile = Dir$(strfolder & "*.doc")

Set doctarget = Documents.Add

Set tblTarget = doctarget.Tables.Add(doctarget.Range, 1, 2)

With tblTarget

.Cell(1, 1).Range.Text = "File Name"

.Cell(1, 2).Range.Text = "Characters"

End With

While strFile <> ""

Set DocSource = Documents.Open(strfolder & strFile)

Set tblrow = tblTarget.Rows.Add

With tblrow

.Cells(1).Range.Text = DocSource.FullName

.Cells(2).Range.Text = DocSource.Characters.Count - DocSource.Paragraphs.Count

End With

DocSource.Close wdDoNotSaveChanges

strFile = Dir$()

Wend

doctarget.Activate

End Sub