计算word文件打印页数 VBA实现

场景复现

最近需要帮我弟打印高考资料，搜集完资料去网上打印，商家发出了这个计算页数的界面。我就好奇怎么实现的，计算的准不准，所以就动手自己用VBA代码实现了一下
在这里插入图片描述

环境说明

因为需要获取word文件的属性，所以需要引用work库。
在这里插入图片描述

在这里插入图片描述

实现原理

获取的是左下角页面的数量，然后把各个文件加起来。
在这里插入图片描述

计算当前文件夹下所有word文件页数总和

先实现计算当前文件夹下所有文件的，不会计算子文件夹。计算原理也很简单，直接要获取
在这里插入图片描述

Sub CountWordPagesInFolder()Dim folderPath As StringDim totalPages As LongDim doc As ObjectDim fileSystem As ObjectDim folder As ObjectDim file As ObjecttotalPages = 0' 设置文件夹路径folderPath = "C:\Users\Administrator\Desktop\读取页数"' 创建FileSystemObjectSet fileSystem = CreateObject("Scripting.FileSystemObject")Set folder = fileSystem.GetFolder(folderPath)' 遍历文件夹中的每个文件For Each file In folder.FilesDebug.Print file.NameIf UCase(fileSystem.GetExtensionName(file.Name)) = "DOCX" Or _UCase(fileSystem.GetExtensionName(file.Name)) = "DOC" Then' 打开Word文件'Set doc = wordApp.Documents.Open(file.Path)' 创建Word应用程序实例Dim wordApp As ObjectSet wordApp = CreateObject("Word.Application")wordApp.Visible = FalseSet doc = wordApp.Documents.Open(file.Path, ReadOnly:=True)' 更新文档以确保准确计算页数'doc.Repaginate'Debug.Print file.Path' 计算页数'totalPages = totalPages + doc.ComputeStatistics(1) ' wdStatisticPages = 1totalPages = totalPages + doc.ComputeStatistics(wdStatisticPages) ' wdStatisticPages = 1' 关闭文档On Error Resume Nextdoc.CloseIf Err.Number <> 0 Then'Handle the error if any...Debug.Print "不正常正常关闭"End IfOn Error GoTo 0End IfNext file' 关闭Word应用程序wordApp.Quit' 输出总页数MsgBox "Total pages in Word files: " & totalPages
End Sub

利用递归计算当前文件夹所有work文件页面数量

folderPath 改成自己的文件夹就行了。

Sub CountWordPagesInFolder()Dim folderPath As StringDim totalPages As LongDim fileSystem As ObjectDim folder As ObjectDim wordApp As ObjecttotalPages = 0' 设置文件夹路径folderPath = "E:\work\高考真题\打印参考答案"' 创建FileSystemObjectSet fileSystem = CreateObject("Scripting.FileSystemObject")Set folder = fileSystem.GetFolder(folderPath)' 创建Word应用程序实例Set wordApp = CreateObject("Word.Application")wordApp.Visible = False' 遍历文件夹及其子文件夹中的所有文件totalPages = TraverseFolders(folder, fileSystem, wordApp)' 关闭Word应用程序wordApp.Quit' 释放对象Set wordApp = NothingSet fileSystem = NothingSet folder = Nothing' 输出总页数MsgBox "Total pages in Word files: " & totalPages
End SubFunction TraverseFolders(folder As Object, fileSystem As Object, wordApp As Object) As LongDim totalPages As LongDim file As ObjectDim subFolder As ObjectDim doc As ObjecttotalPages = 0' 遍历文件夹中的每个文件For Each file In folder.FilesDebug.Print fileIf UCase(fileSystem.GetExtensionName(file.Name)) = "DOCX" Or _UCase(fileSystem.GetExtensionName(file.Name)) = "DOC" Then' 打开Word文件On Error Resume NextSet doc = wordApp.Documents.Open(file.Path, ReadOnly:=True)If Err.Number <> 0 ThenDebug.Print "无法打开文件: " & file.Path & " 错误信息: " & Err.DescriptionErr.ClearOn Error GoTo 0GoTo NextFileEnd IfOn Error GoTo 0' 计算页数totalPages = totalPages + doc.ComputeStatistics(wdStatisticPages)' 关闭文档'doc.Close SaveChanges:=FalseEnd If
NextFile:Next file' 遍历子文件夹For Each subFolder In folder.SubFolderstotalPages = totalPages + TraverseFolders(subFolder, fileSystem, wordApp)Next subFolderTraverseFolders = totalPages
End Function

几个BUG

'doc.Close SaveChanges:=False

doc对象正常来说用完就应关闭的，但是关闭后打开第二个文件机会报错
Set doc = wordApp.Documents.Open(file.Path, ReadOnly:=True)
在这里插入图片描述
查询官网和GPT 都没给出很好的解释，然后我尝试关闭后每次重新创建一个wordApp对象读取文件信息，就不会报错。估计是关闭文件会释放这个对象资源或者其他，肯定会影响。
Set wordApp = CreateObject(“Word.Application”)
wordApp.Visible = False

Sub CountWordPagesInFolder()Dim folderPath As StringDim totalPages As LongDim doc As ObjectDim fileSystem As ObjectDim folder As ObjectDim file As ObjecttotalPages = 0' 设置文件夹路径folderPath = "C:\Users\Administrator\Desktop\读取页数"' 创建FileSystemObjectSet fileSystem = CreateObject("Scripting.FileSystemObject")Set folder = fileSystem.GetFolder(folderPath)' 遍历文件夹中的每个文件For Each file In folder.FilesDebug.Print file.NameIf UCase(fileSystem.GetExtensionName(file.Name)) = "DOCX" Or _UCase(fileSystem.GetExtensionName(file.Name)) = "DOC" Then' 打开Word文件'Set doc = wordApp.Documents.Open(file.Path)' 创建Word应用程序实例Dim wordApp As ObjectSet wordApp = CreateObject("Word.Application")wordApp.Visible = FalseSet doc = wordApp.Documents.Open(file.Path, ReadOnly:=True)' 更新文档以确保准确计算页数'doc.Repaginate'Debug.Print file.Path' 计算页数'totalPages = totalPages + doc.ComputeStatistics(1) ' wdStatisticPages = 1totalPages = totalPages + doc.ComputeStatistics(wdStatisticPages) ' wdStatisticPages = 1' 关闭文档On Error Resume Nextdoc.CloseIf Err.Number <> 0 Then'Handle the error if any...Debug.Print "不正常正常关闭"End IfOn Error GoTo 0End IfNext file' 关闭Word应用程序wordApp.Quit' 输出总页数MsgBox "Total pages in Word files: " & totalPages
End Sub