CODEWITHSUNDEEP
vbaexcelms-word
sameer_88
sameer_88

Reputation: 29

Count words in a document and output to excel

I have about 10 Word documents labeled (1,2,3 etc.). I have a requirement to count the number of words and the number of misspelled words in each document and output this count to Excel.

How do I write a VBA script for this?

In word I know how to find out the word count and the number of misspelled words and display that as a Msgbox, but I'm not sure how to make excel read through word documents and display the output.

Ideally, the excel file will to ask me to select all the word documents, and then produce a sheet that has:

Doc Name   Word_count   Misspelled_count
1              30            9
2              45            8
3              50            15
.
.

My VBA code in Word to display error and word count is:

Sub get_wpm_errorcount()
Dim ThisDoc As Document
Dim ErrorCnt As Integer
Dim WordCnt As Integer

Set ThisDoc = ActiveDocument

WordCnt = ThisDoc.Range.ComputeStatistics(wdStatisticWords)
ErrorCnt = ThisDoc.SpellingErrors.Count
MsgBox ("WPM = " & WordCnt & "   Error Count = " & ErrorCnt)

End Sub

EDIT:
I tried my hand at this and this is what I came up with ..

Dim RunErrorCount As Integer    'Global running total of errors
Dim FilesToOpen                 'Global list of files to open
Dim FileCount As Integer        'Global count of files to open

Private Sub ReadtextFile()

Dim x As Integer
Dim wkbAll As Workbook
Dim wkbTemp As Workbook

On Error GoTo ErrHandler
Application.ScreenUpdating = False

FilesToOpen = Application.GetOpenFilename _
    (FileFilter:="All Files (*.*),*.*", _
    MultiSelect:=True, Title:="Text Files to Open")

If TypeName(FilesToOpen) = "Boolean" Then
    MsgBox "No Files were selected"
    GoTo ExitHandler
End If

x = 1

Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))

Call get_wpm_errorcount

Range("A1").Offset(FileCount + 1, 0).Select
Selection.NumberFormat = "0.00"
ActiveCell.Value = FilesToOpen(x).Name  'Output filename

Range("B1").Offset(FileCount + 1, i).Select
Selection.NumberFormat = "0.00"
ActiveCell.Value = WordCount  'Output total count

Range("C1").Offset(FileCount + 1, i).Select
Selection.NumberFormat = "0.00"
ActiveCell.Value = ErrorCount  'Output total count

x = x + 1

FileCount = UBound(FilesToOpen)

End Sub

Sub get_wpm_errorcount(ThisDoc As Object)
Dim ErrorCnt As Integer
Dim WordCnt As Integer

WordCnt = ThisDoc.Range.ComputeStatistics(wdStatisticWords)
ErrorCnt = ThisDoc.SpellingErrors.Count

End Sub

What am I doing wrong???

Upvotes: 0

Views: 3481

Answers (1)

David Zemens
David Zemens

Reputation: 53663

Should be pretty easy. Modify as needed.

You need your Excel to open (and then control) Word. This is called "binding". The example below will bind Word to Excel:

Option Explicit
'NOTE: REQUIRES REFERENCE TO MS WORD
Sub main()
Dim wordApp as Word.Application
Dim wordDoc as Word.Document
Dim fd As FileDialog
Dim listFiles As Variant
Dim i As Long

'Display the file dialog to allow the user to select file(s)
Set fd = Application.FileDialog(msoFileDialogFilePicker)
    fd.AllowMultiSelect = True
    fd.ButtonName = "Select Files to Process"
    fd.Show

'Create Word Application only if needed:
If fd.SelectedItems.Count > 0 Then Set wordApp = CreateObject("Word.Application")

'Then iterate th selected items and open them in Word:
For i = 1 to fd.SelectedItems.Count

    Set wordDoc = wordApp.Documents.Open(fd.SelectedItems(i))  


    'Send the document object AND the integer i to the other function
    ' which will read the document and print results to Excel spreadsheet
    Call get_wpm_errorcount(wordDoc, i)

    wordDoc.Close
Next

Set wordApp = Nothing


End Sub

Sub get_wpm_errorcount(ThisDoc As Object, itemNumber as Integer)
Dim ErrorCnt As Integer
Dim WordCnt As Integer

WordCnt = ThisDoc.Range.ComputeStatistics(wdStatisticWords)
ErrorCnt = ThisDoc.SpellingErrors.Count

Range("A1").Offset(itemNumber, 0).Value = WordCnt
Range("B1").Offset(itemNumber, 0).Value = ErrorCnt

End Sub

Upvotes: 4

Related Questions