「高阶应用」不打开Word文档获取总页数(1)-doc文件怎么打开

「高阶应用」不打开Word文档获取总页数(1)

打开word文档获取总页数的方法很多:

Selection.Information(wdNumberOfPagesInDocument)
ActiveDocument.ComputeStatistics(wdStatisticPages)
ActiveDocument.ActiveWindow.ActivePane.Pages.Count
ActiveDocument.BuiltinDocumentProperties(wdPropertyPages)

当然以上方法里,第2和第4两种方法更方便封装

以上方法缺点是需要打开文件才能获取页数

优点是获取到的页数是准确的

以下讲一下解析2007以上文件的方法来获取页数,需要用到一个typelib(oleexp.tlb)

因为发链接限制比较多,就不发链接了

引用tlb之后,测试一下代码:

Private Declare Function SHParseDisplayName Lib "shell32" (ByVal pszName As Long, ByVal IBindCtx As Long, ByRef ppidl As Long, sfgaoIn As Long, sfgaoOut As Long) As Long

Private Declare Function ILFree Lib "shell32" (ByVal pidlFree As Long) As Long

Private Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long

Private Declare Function SysAllocStringByteLen Lib "oleaut32.dll" (Optional ByVal pszStrPtr As Long, Optional ByVal Length As Long) As String

Private Const CLSID_Zip = "{E88DCCE0-B7B3-11d1-A9F0-00AA0060FA31}"

Private Const IID_IShellExtInit = "{000214E8-0000-0000-C000-000000000046}"

Function GetPageCount(ByVal strFilePath As String) As Long 'xml文档docx

Dim CLSID As UUID

Dim iid As UUID

Dim IExt As oleexp.IShellExtInit

Dim IPF As oleexp.IPersistFolder2

Dim iStg As oleexp.IStorage

Dim iStat As oleexp.STATSTG

Dim docProps As oleexp.IStorage

Dim appxml As oleexp.IStream

Dim pidl As Long

Dim cb As Long

Dim buf() As Byte

Dim strTemp As String

Dim arr() As String

CLSIDFromString CLSID_Zip, CLSID

CLSIDFromString IID_IShellExtInit, iid

If CoCreateInstance(CLSID, Nothing, 1&, iid, IExt) <> 0 Then GoTo lExit

Set IPF = IExt

SHParseDisplayName StrPtr(strFilePath), 0, pidl, 0, 0

IPF.Initialize pidl

ILFree pidl

Set iStg = IPF

Set docProps = iStg.OpenStorage("docProps", 0, STGM_READ, 0, 0)

Set appxml = docProps.OpenStream("app.xml", 0, STGM_READ, 0)

appxml.stat iStat, STATFLAG_NOOPEN

ReDim buf(10000 * iStat.cbSize - 1)

cb = appxml.Read(buf(0), UBound(buf) + 1)

If cb Then

strTemp = SysAllocStringByteLen(VarPtr(buf(0)), lstrlenA(VarPtr(buf(0))))

End If

mySplit strTemp, arr, "</Pages>" '内置Split的效率不能忍

mySplit arr(0), arr, "<Pages>"

GetPageCount = arr(1)

lExit:

End Function

Public Sub mySplit(ByVal Expression$, ResultSplit$(), Optional Delimiter$ = " ")

' By Chris Lucas, cdl1051@earthlink.net, 20011208

Dim c&, SLen&, DelLen&, tmp&, Results&()

SLen = LenB(Expression) \ 2

DelLen = LenB(Delimiter) \ 2

If SLen = 0 Or DelLen = 0 Then ' Bail if we were passed an empty delimiter or an empty expression

ReDim Preserve ResultSplit(0 To 0)

ResultSplit(0) = Expression

Exit Sub

End If

ReDim Preserve Results(0 To SLen) ' Count delimiters and remember their positions

tmp = InStr(Expression, Delimiter)

Do While tmp

Results(c) = tmp

c = c + 1

tmp = InStr(Results(c - 1) + 1, Expression, Delimiter)

Loop

ReDim Preserve ResultSplit(0 To c) ' Size our return array

If c = 0 Then ' Populate the array

ResultSplit(0) = Expression ' lazy man's call

Else

ResultSplit(0) = Left$(Expression, Results(0) - 1) ' typical call

For c = 0 To c - 2

ResultSplit(c + 1) = Mid$(Expression, Results(c) + DelLen, Results(c + 1) - Results(c) - DelLen)

Next c

ResultSplit(c + 1) = Right$(Expression, SLen - Results(c) - DelLen + 1)

End If

End Sub

代码写的比较粗糙,直接从内存中获取app.xml文件,并直接读取里面的<Pages>页数</Pages>字段

MySplit只是个提高自带Split函数效率的方法

这样读取的方法有一个确定,当文档的页数跟app.xml文件里的页数不对等时,这里获取到的当然就是错的。

为什么会有文档页数和app.xml里面不相等的情况了,因为不是文件有足够的页数,文件里的所有流都会实时更新

推荐阅读