How to open a Word.doc using VBA and count the words in the word.doc?

**eijoah** · 10-31-2007, 11:30 PM

I have problem writing a code to open a word.doc and count the different number of words in the doc. my code is as follows. Can anyone tell me what is the prob?

 
Sub automateword()


    Set wordapp = CreateObject("word.Application")


    wordapp.Documents.Open "C:\Documents and Settings\Admin\Desktop\letter.doc"
    
    wordapp.Visible = True

Dim totalwords As Long

totalwords = Activeworksheet.Words.Count

Dim i As Long, Word As Range, str As String, j As Long, f As Integer

Dim arr() As String


For Each Word In ActiveDocument.Words
    For i = 1 To totalwords Step 1
    f = 0
        For j = i To totalwords Step 1
     If arr(i) = arr(j) Then
     f = f + 1
      Range("A1").Offset(i, 0).Value = Word
      Range("B1").Offset(i, 0).Value = f
    End If
    Next
    
    
    Next
Next

End Sub

**rylo** · 11-01-2007, 07:39 PM

Hi

See how this goes.

Sub automateword()

  Dim nodupes As New Collection
  Dim TotalWords As Long
  Dim WordApp As Object
  Set WordApp = CreateObject("word.Application")
  WordApp.Documents.Open "C:\Documents and Settings\Admin\Desktop\letter.doc"
  
    
  'wordapp.Visible = True

  TotalWords = WordApp.activedocument.Words.Count


  On Error Resume Next
  For Each wrd In WordApp.activedocument.Words
    nodupes.Add Item:=wrd, key:=wrd
  Next
  On Error GoTo 0
  
  MsgBox "Total Words: " & TotalWords & " Unique Words: " & nodupes.Count
  
  WordApp.Quit
  Set WordApp = Nothing

End Sub

rylo

**eijoah** · 11-02-2007, 02:19 AM

Thnks for your help. It worked. Do you mind if u can help me with how can i make all the word in the word.doc file to be tabulated so as to able to know the frequency of evry repeated words? thnks if anyone can help..

**rylo** · 11-04-2007, 09:52 PM

Hi

Try this

Sub automateword()

  Dim nodupes As New Collection
  Dim TotalWords As Long
  Dim WordApp As Object
  Set WordApp = CreateObject("word.Application")
  Set dic = CreateObject("scripting.dictionary")
  WordApp.Documents.Open "C:\Documents and Settings\Admin\Desktop\letter.doc"
  
  
    
  'wordapp.Visible = True
  
  TotalWords = WordApp.activedocument.words.Count


  For Each wrd In WordApp.activedocument.words
    If Not dic.Exists(wrd.Text) Then
      dic.Add Item:=1, key:=wrd.Text
    Else
      dic(wrd.Text) = dic(wrd.Text) + 1
    End If
  Next wrd
  
  'MsgBox "Total Words: " & TotalWords & " Unique Words: " & nodupes.Count
  Range("A:B").ClearContents
  For Each ce In dic.keys
    outrow = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Cells(outrow, 1).Value = ce
    Cells(outrow, 2).Value = dic(ce)
  Next ce
  
  WordApp.Quit
  Set WordApp = Nothing

End Sub

Something I found out is that the wordcount used this way will include all the punctuation and paragraph marks. It doesn't bring back the same count as the word count from the document itself.

The above script will therefore show some "blank" characters which may be paragraph marks, tabs etc.

HTH

rylo