如何用vba代码自定义获取pdf文件页数的函数？

楼主 kevinchengcw	Q: 如何用vba代码自定义获取pdf文件页数的函数？ A: 自定义函数代码如下： Function GetPages(FileName As String) '变量为全路径文件名 Dim FN$, FSO, mFile, Str$, RegEx, P% FN = FileName '取得文件名（注：全路径） Set FSO = CreateObject("scripting.filesystemobject") '创建FSO项目用于打开文件 Set RegEx = CreateObject("vbscript.regexp") '创建正则项目，用于匹配关键字段 With RegEx .Global = True '全程有效 .MultiLine = True '多行有效 .Pattern = "/Count [\d]+" '关键字特征“/Count 页数” End With Set mFile = FSO.opentextfile(FN) '以文本形式打开pdf文件 P = 0 '初始化一下页数值，防止出错 Do While Not mFile.atendofstream '循环直到文件结尾 Str = mFile.readline '读取一行（如此操作是为了避免读入数据量太大） If Str Like "/Count #" Then P = IIf(Val(Split(RegEx.Execute(Str)(0).Value, " ")(1)) > P, Val(Split(RegEx.Execute(Str)(0).Value, " ")(1)), P) '取得对应的关键字段中的数值（即页数值） Loop mFile.Close '关闭文件 If P = 0 Then '如果未取得数值或取得0值，则返回"?" GetPages = "?" Else '否则返回取得的页数值 GetPages = P End If Set mFile = Nothing '清空创建的项目 Set FSO = Nothing Set RegEx = Nothing End Function 以上代码也可修改为sub程序来运行进行批量处理。
2楼 kevinchengcw	一年半啦，简化一下吧 Function GetPages(FileName As String) '变量为全路径文件名 Dim Match, Str$, P% With CreateObject("scripting.filesystemobject").opentextfile(FileName) Str = .readall .Close End With P = 0 With CreateObject("vbscript.regexp") .Global = True .MultiLine = True .Pattern = "\/Count ([\d]+)" If .test(Str) Then For Each Match In .Execute(Str) If Val(Match.submatches(0)) > P Then P = Val(Match.submatches(0)) Next Match End If End With GetPages = IIf(P = 0, "?", P) End Function
3楼 ljh29206	版主问下打印的命令如何呢如果我想打印按页数的数量如果大于 6 则前2页打印2次如果小于 6 则前2页打印1次. 其他全部1次. 该这么操作?
4楼 ljh29206	Sub df() Dim FileName As String Dim Match, Str$, P% FileName = Application.GetOpenFilename("PDF文件(.PDF),.PDF") With CreateObject("scripting.filesystemobject").opentextfile(FileName) Str = .readall .Close End With P = 0 With CreateObject("vbscript.regexp") .Global = True .MultiLine = True .Pattern = "\/Count ([\d]+)" If .test(Str) Then For Each Match In .Execute(Str) If Val(Match.submatches(0)) > P Then P = Val(Match.submatches(0)) Next Match End If End With MsgBox (P) End Sub 读不出页数,麻烦 K版帮忙看下.
5楼 kevinchengcw	方便的话，把读不出页数的文件下传看下
6楼 ljh29206	很奇怪我就那个文件不行！再试了其他的几个都可以！由于 30M 有多上传不了！另 K版问下打印的命令怎么写如果我想打印按页数的数量如果大于 6 则前2页打印2次如果小于 6 则前2页打印1次. 其他全部1次. 该这么操作?
7楼 kevinchengcw	vba不通过控件似乎没办法控件pdf的打印，这个要看你安装的哪个pdf阅读软件，及他是否支持其他程序调用了
8楼 ljh29206	我这边使用的是 adobe reader 9 的软件打开的请问可否做到? 另外 K版能推介一个阅读软件能够做得到?
9楼 kevinchengcw	这方面我也没尝试过，你可以先搜索一下，看有没有现成的实例供参考
10楼 ljh29206	Sub AcrobatPrint() Dim FileName As String Dim Match, Str$, P% FileName = Application.GetOpenFilename("PDF文件(.PDF),.PDF") With CreateObject("scripting.filesystemobject").opentextfile(FileName) Str = .readall .Close End With Dim PrintMode As String PrintMode = InputBox("all or first") Dim AcroExchApp As Acrobat.CAcroApp Dim AcroExchAVDoc As Acrobat.CAcroAVDoc Dim AcroExchPDDoc As Acrobat.CAcroPDDoc Dim num As Integer Set AcroExchApp = CreateObject("AcroExch.App") Set AcroExchAVDoc = CreateObject("AcroExchAV.Doc") AcroExchAVDoc.Open FileName, "" Set AcroExchPDDoc = AcroExchAVDoc.GetPDDoc num = AcroExchPDDoc.GetNumPages - 1 If PrintMode = "all" Then 'Print all pages Call AcroExchAVDoc.PrintPages(0, num, 2, 1, 1) Else 'Print first page Call AcroExchAVDoc.PrintPages(0, 0, 2, 1, 1) End If End Sub 我在网上找到以上代码, 打印第一页或者全部. 但 Set AcroExchApp = CreateObject("AcroExch.App") Set AcroExchAVDoc = CreateObject("AcroExchAV.Doc") 提示 ACtive x 部件不能创建对象我引用了关于 adobe reader 9.0 的全部控件都不行. 可否帮忙看下有没的搞 , K版
11楼 kevinchengcw	估计是对应的dll或ocx文件没有注册，不过先要知道对应的是哪些文件