统计WORD页码字数

模快一：
Sub WORD文件统计()
Dim wapp, m, k, word1
Dim numc As Integer, numpic As Integer, numpage As Integer, numtable As Integer, filename As String
Dim rowend As Integer, i%
With ThisWorkbook.Sheets(1)
.Range(“a2:e100000”).Clear
Set wapp = CreateObject(“Word.Application”)
m = Application.GetOpenFilename(Title:=“打开文件”, MultiSelect:=True, filefilter:=“WORD文件(.doc),.doc”)
'判断是否选中文件
If Not IsArray(m) Then
Application.ScreenUpdating = True
Exit Sub
End If

For Each k In m
   Set word1 = wapp.Documents.Open(k)
    wapp.Windows(1).Visible = True
    .Range("a" & i + 2) = word1.Name '文件名
    .Range("b" & i + 2) = word1.BuiltinDocumentProperties(wdPropertyWords) '字数
    .Range("c" & i + 2) = word1.Range.Information(wdNumberOfPagesInDocument) '页数
    .Range("d" & i + 2) = word1.InlineShapes.Count '图片数
    .Range("e" & i + 2) = word1.tables.Count '表格数
    i = i + 1
    word1.Close False
    Set word1 = Nothing
Next

End With
wapp.Quit
Set wapp = Nothing
MsgBox “done”, , “统计完毕”
End Sub

模块二
Sub 文件改名()
Dim X%, Y%

X = [A65536].End(xlUp).Row
On Error Resume Next
For Y = 2 To X
If Cells(Y, 2) <> “” Then
Name ActiveWorkbook.Path & “” & Cells(Y, 1) As ActiveWorkbook.Path & “” & Cells(Y, 2)
End If
Next
MsgBox “完成”
End Sub

模块三
Sub 列出所有文件名()
Dim A%
A = [A65536].End(xlUp).Row
If A > 1 Then: Range(“A2:A” & A).ClearContents
Dim xlsFile As String, XX As String
XX = Range(“C2”).Text
xlsFile = Dir(ActiveWorkbook.Path & “” & XX)
Do
If InStr(1, xlsFile, “操作表”) = 0 Then
Cells(([A65536].End(xlUp).Row + 1), 1) = xlsFile

End If
xlsFile = Dir
Loop Until Len(xlsFile) = 0
MsgBox “完成”
End Sub