请问如果统计一个多层目录下的所有子文件夹内word文档的字数

cionysus

一个多层文件夹，我想统计里面所有word文档（包括doc和docx格式）的字数。
统计的结果生成在顶层目录内一个叫“字数统计.xlsx”的excel文档里。
请问用excel vba该如何实现？
以下压缩包是实例文件和结果excel文件。
包含docx或者doc的目录（目录有多层）.rar (38.1 KB, 下载次数: 5)

2020-6-18 20:55 上传

点击文件名下载附件

cionysus

求大佬出手！

蓝桥玄霜

1. Dim mf&
   
2. Sub lqxs()
   
3. Dim Fso As Object, sPath$, WD As Object, i&, Arrf$(), aa, nm$, wj$, intWords%
   
4. Dim doc As Object
   
5. sPath = ThisWorkbook.Path & ""
   
6. Set Fso = CreateObject("Scripting.FileSystemObject")
   
7. Set WD = CreateObject("Word.Application")
   
8. WD.Visible = False
   
9. Sheet1.Activate
   
10. [a2:b500].ClearContents
    
11. Call GetFiles(sPath, Fso, Arrf)
    
12. For i = 1 To UBound(Arrf)
    
13.     aa = Split(Arrf(i), "")
    
14.     nm = aa(UBound(aa))
    
15.     wj = Split(nm, ".")(0)
    
16.     Cells(i + 1, 1) = wj
    
17.     Set doc = WD.documents.Open(Arrf(i))
    
18.     intWords = WD.ActiveDocument.BuiltinDocumentProperties(15)
    
19.     Cells(i + 1, 2) = intWords
    
20.     doc.Close
    
21.     Set doc = Nothing
    
22. Next
    
23.     Set WD = Nothing
    
24. End Sub
    
25. 
    
26. Sub GetFiles(ByVal sPath$, ByRef Fso As Object, ByRef Arrf$())
    
27.     Dim Folder As Object
    
28.     Dim SubFolder As Object
    
29.     Dim File As Object
    
30.     Set Folder = Fso.GetFolder(sPath)
    
31.    
    
32.     For Each File In Folder.Files
    
33.         If InStr(File, ".doc") Then
    
34.             mf = mf + 1
    
35.             ReDim Preserve Arrf(1 To mf)
    
36.             Arrf(mf) = File.Path
    
37.         End If
    
38.     Next
    
39.     For Each SubFolder In Folder.SubFolders
    
40.         Call GetFiles(SubFolder.Path, Fso, Arrf)
    
41.     Next
    
42.     If mf = 0 Then MsgBox "没有文件，程序退出。"
    
43.     Set Folder = Nothing
    
44.     Set File = Nothing
    
45. End Sub
    

复制代码

cionysus

蓝桥玄霜 发表于 2020-6-23 11:40

运行成功，十分感谢！

我想顺便再请问下，如果我想生成的结果报告文件“字数统计”是word文件，内容还是这个两列的表格，该怎么实现？