I need to Character Count multiple documents.

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

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?

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")

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. 

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