打开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里面不相等的情况了,因为不是文件有足够的页数,文件里的所有流都会实时更新