VBA to Count Words in MS Word Doc and List Down it in excel

Hi Team,

What could be done in case where i want to count words of a bunch of document in folder and also required output in excel file.

I have something that i found from some where.

Sub ListWordCount()
    'In the Visual Basic Editor,
    'go to Tools -> References and check the box for
    'Microsoft Scripting Runtime to access the
    'filesystem object.

    Dim fso As Scripting.FileSystemObject
    Dim fol As Scripting.Folder
    Dim cfil As Variant
    Dim fil_1 As Scripting.File

    Dim s As String

    'The FSO isn't the fastest object in existence
    'and much slower than using the Windows API (or its
    'VB.Net namesake for that matter) but it's convenient
    'and easy to use.
    Set fso = New FileSystemObject
    Set fol = fso.GetFolder("C:\Users\harshadp\Desktop\New folder (2)")
    Set cfil = fol.Files

    'Helps it run a bit faster...
    Application.ScreenUpdating = True

    For Each fil_1 In cfil

        Select Case fil_1.Type
            'Add any other types that you want to check for
            Case "Microsoft Word 97 - 2003 Document", "Microsoft Word Document"

            Documents.Open FileName:=fil_1.path

            Debug.Print fil_1.Name & vbTab & _
             ActiveDocument.Range.ComputeStatistics(wdStatisticWords) _
             & " words."

            Documents.Close savechanges:=False

      End Select

    Next

ExitPoint:
On Error Resume Next
Set fil_1 = Nothing
Set cfil = Nothing
Set fol = Nothing
Set fso = Nothing
Application.ScreenUpdating = True
Application.ScreenRefresh
On Error GoTo 0

Exit Sub

ErrorHandler:

MsgBox Err.Number & vbCr & Err.Description

Resume ExitPoint

End Sub

This macro runs fine in word givign error in excel

Welcome to the board.

Sub ListWordCount()
    'In the Visual Basic Editor,
    'go to Tools -> References and check the box for
    'Microsoft Scripting Runtime to access the
    'filesystem object.

    Dim fso As Scripting.FileSystemObject
    Dim fol As Scripting.Folder
    Dim cfil As Variant
    Dim fil_1 As Scripting.File
    'Late binding
    Dim WdApp As Object
    Dim WdDoc As Object
    Dim s As String
    Dim MyPath$
    Dim Ctr As Long
    
    Set WdApp = CreateObject("Word.Application")
    'The FSO isn't the fastest object in existence
    'and much slower than using the Windows API (or its
    'VB.Net namesake for that matter) but it's convenient
    'and easy to use.
    Set fso = New FileSystemObject
    MyPath$ = "C:\Users\harshadp\Desktop\New folder (2)"
    Set fol = fso.GetFolder(MyPath$)
    Set cfil = fol.Files

    'Helps it run a bit faster...
    Application.ScreenUpdating = True
    Ctr = 2
    For Each fil_1 In cfil
            'Debug.Print fil_1.Type
        Select Case fil_1.Type
            'Add any other types that you want to check for
            Case "Microsoft Office Word 97 - 2003 Document", "Microsoft Word Document"

            Set WdDoc = WdApp.Documents.Open(Filename:=fil_1.Path, ConfirmConversions:=False, _
                ReadOnly:=True)

            Worksheets(1).Cells(Ctr, 1) = fil_1.Name
            Worksheets(1).Cells(Ctr, 2) = WdDoc.Range.ComputeStatistics(0)
            Ctr = Ctr + 1
            WdDoc.Close savechanges:=False
      End Select
    Next
ExitPoint:
On Error Resume Next
Set fil_1 = Nothing
Set cfil = Nothing
Set fol = Nothing
Set fso = Nothing
Set WdDoc = Nothing
Set WdApp = Nothing
Application.ScreenUpdating = True
Application.ScreenRefresh
On Error GoTo 0

Exit Sub

ErrorHandler:

MsgBox Err.Number & vbCr & Err.Description

Resume ExitPoint

End Sub

You really should start a new thread and reference this one.

However, add this:

Function GetFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

Change this

MyPath$ = "C:\Users\harshadp\Desktop\New folder (2)"

to

MyPath$ = GetFolder

Probably would be a good idea to test for a empty folder in case the user cancels.

Sorry, but I don't really know why it's only processing 60 of 90 files.

Search is your friend

sudarbharath,
Unfortunately your post does not comply with Rule 2 of our Forum RULES. Do not post a question in the thread of another member -- start your own thread.

If you feel an existing thread is particularly relevant to your need, provide a link to the other thread in your new thread.

Old threads are often only monitored by the original participants. New threads not only open you up to all possible participants again, they typically get faster response, too.