Dim dFilePath As Object, OneKey
Sub main_proc()
Dim Wb As Workbook, Sht As Worksheet, Rng As Range
Set Wb = Application.ThisWorkbook
Set Sht = Wb.Worksheets(1)
Set dFilePath = CreateObject("Scripting.Dictionary")
RecursionFolder ThisWorkbook.Path & "\"
For Each OneKey In dFilePath.keys
Ar = dFilePath(OneKey)
Ar(2) = WordCount(Ar(1))
Debug.Print Ar(2) & " " & Ar(1)
dFilePath(OneKey) = Ar
Next OneKey
With Sht
.UsedRange.Offset(1).Clear
Set Rng = .Range("A2")
Set Rng = Rng.Resize(dFilePath.Count, 3)
Rng.Value = Application.Rept(dFilePath.items, 1)
End With
Set Wb = Nothing
Set Sht = Nothing
Set Rng = Nothing
Set dFilePath = Nothing
End Sub
Sub RecursionFolder(ByVal FolderPath As String)
Dim Fso As Object
Dim MainFolder As Object
Dim OneFolder As Object
Dim OneFile As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set MainFolder = Fso.GetFolder(FolderPath)
For Each OneFile In MainFolder.Files
If OneFile.Name Like "*.doc*" Then
dFilePath(dFilePath.Count + 1) = Array(OneFile.Name, OneFile.Path, 0)
End If
Next
For Each OneFolder In MainFolder.SubFolders
RecursionFolder OneFolder.Path
Next
Set Fso = Nothing
Set MainFolder = Nothing
End Sub
Private Function WordCount(ByVal FilePath As String) As Long
Dim wdApp As Object
Dim wdDoc As Object
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If wdApp Is Nothing Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
WordCount = 0
On Error Resume Next
Set wdDoc = wdApp.Documents.Open(FilePath)
If wdDoc Is Nothing Then
wdApp.Quit
Set wdApp = Nothing
On Error GoTo 0
Exit Function
Else
WordCount = wdDoc.ComputeStatistics(0, False) '0为字数
wdDoc.Close False
wdApp.Quit
Set wdApp = Nothing
End If
End Function
