VBA统计多个WORD文档页数、字数图片等

anijoe123

我在EXCEL中写了个模块统计若干个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.BuiltinDocumentProperties(wdPropertyPages)'页数
        .Range("c" & i + 2) = word1.ComputeStatistics(Statistic:=wdStatisticPages, IncludeFootnotesAndEndnotes:=True) '页数
        .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", , "统计完毕"
word统计.rar (17.57 KB, 下载次数: 60)

2014-4-22 09:43 上传

点击文件名下载附件

修改后的附件：
word属性统计.rar (17.99 KB, 下载次数: 153)

2014-4-28 12:04 上传

点击文件名下载附件

loquat

BuiltinDocumentProperties可能会不准吧。。。
用Information或者你写的那个ComputeStatistics，或者Pages.count

anijoe123

loquat 发表于 2014-4-22 12:38
BuiltinDocumentProperties可能会不准吧。。。
用Information或者你写的那个ComputeStatistics，或者Pages ...

试出来了，用range.Information可以，用ComputeStatistics也不行

loquat

ActiveDocumeng.Information就可以了

psystyle

根据上面的意见修改，总是出错？能否贴上修改后的代码？

413191246se

MsgBox "共 " & Selection.Information(wdNumberOfPagesInDocument) & " 页  "

23410862

楼主能把修改后的代码贴上来吗？谢谢了！

anijoe123

修改后的附件...

努牛

谢谢了，这个便捷！

recoba92

运行显示activeX控件不能创建对象，怎么办呢？