目录
场景复现
最近需要帮我弟打印高考资料，搜集完资料去网上打印，商家发出了这个计算页数的界面。我就好奇怎么实现的，计算的准不准，所以就动手自己用VBA代码实现了一下
环境说明
因为需要获取word文件的属性，所以需要引用work库。
实现原理
获取的是左下角页面的数量，然后把各个文件加起来。
计算当前文件夹下所有word文件页数总和
先实现计算当前文件夹下所有文件的，不会计算子文件夹。计算原理也很简单，直接要获取
bash
Sub CountWordPagesInFolder()
Dim folderPath As String
Dim totalPages As Long
Dim doc As Object
Dim fileSystem As Object
Dim folder As Object
Dim file As Object
totalPages = 0
' 设置文件夹路径
folderPath = "C:\Users\Administrator\Desktop\读取页数"
' 创建FileSystemObject
Set fileSystem = CreateObject("Scripting.FileSystemObject")
Set folder = fileSystem.GetFolder(folderPath)
' 遍历文件夹中的每个文件
For Each file In folder.Files
Debug.Print file.Name
If 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 Object
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = False
Set doc = wordApp.Documents.Open(file.Path, ReadOnly:=True)
' 更新文档以确保准确计算页数
'doc.Repaginate
'Debug.Print file.Path
' 计算页数
'totalPages = totalPages + doc.ComputeStatistics(1) ' wdStatisticPages = 1
totalPages = totalPages + doc.ComputeStatistics(wdStatisticPages) ' wdStatisticPages = 1
' 关闭文档
On Error Resume Next
doc.Close
If Err.Number <> 0 Then
'Handle the error if any...
Debug.Print "不正常正常关闭"
End If
On Error GoTo 0
End If
Next file
' 关闭Word应用程序
wordApp.Quit
' 输出总页数
MsgBox "Total pages in Word files: " & totalPages
End Sub利用递归计算当前文件夹所有work文件页面数量
folderPath 改成自己的文件夹就行了。
bash
Sub CountWordPagesInFolder()
Dim folderPath As String
Dim totalPages As Long
Dim fileSystem As Object
Dim folder As Object
Dim wordApp As Object
totalPages = 0
' 设置文件夹路径
folderPath = "E:\work\高考真题\打印参考答案"
' 创建FileSystemObject
Set 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 = Nothing
Set fileSystem = Nothing
Set folder = Nothing
' 输出总页数
MsgBox "Total pages in Word files: " & totalPages
End Sub
Function TraverseFolders(folder As Object, fileSystem As Object, wordApp As Object) As Long
Dim totalPages As Long
Dim file As Object
Dim subFolder As Object
Dim doc As Object
totalPages = 0
' 遍历文件夹中的每个文件
For Each file In folder.Files
Debug.Print file
If UCase(fileSystem.GetExtensionName(file.Name)) = "DOCX" Or _
UCase(fileSystem.GetExtensionName(file.Name)) = "DOC" Then
' 打开Word文件
On Error Resume Next
Set doc = wordApp.Documents.Open(file.Path, ReadOnly:=True)
If Err.Number <> 0 Then
Debug.Print "无法打开文件: " & file.Path & " 错误信息: " & Err.Description
Err.Clear
On Error GoTo 0
GoTo NextFile
End If
On Error GoTo 0
' 计算页数
totalPages = totalPages + doc.ComputeStatistics(wdStatisticPages)
' 关闭文档
'doc.Close SaveChanges:=False
End If
NextFile:
Next file
' 遍历子文件夹
For Each subFolder In folder.SubFolders
totalPages = totalPages + TraverseFolders(subFolder, fileSystem, wordApp)
Next subFolder
TraverseFolders = 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
bash
Sub CountWordPagesInFolder()
Dim folderPath As String
Dim totalPages As Long
Dim doc As Object
Dim fileSystem As Object
Dim folder As Object
Dim file As Object
totalPages = 0
' 设置文件夹路径
folderPath = "C:\Users\Administrator\Desktop\读取页数"
' 创建FileSystemObject
Set fileSystem = CreateObject("Scripting.FileSystemObject")
Set folder = fileSystem.GetFolder(folderPath)
' 遍历文件夹中的每个文件
For Each file In folder.Files
Debug.Print file.Name
If 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 Object
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = False
Set doc = wordApp.Documents.Open(file.Path, ReadOnly:=True)
' 更新文档以确保准确计算页数
'doc.Repaginate
'Debug.Print file.Path
' 计算页数
'totalPages = totalPages + doc.ComputeStatistics(1) ' wdStatisticPages = 1
totalPages = totalPages + doc.ComputeStatistics(wdStatisticPages) ' wdStatisticPages = 1
' 关闭文档
On Error Resume Next
doc.Close
If Err.Number <> 0 Then
'Handle the error if any...
Debug.Print "不正常正常关闭"
End If
On Error GoTo 0
End If
Next file
' 关闭Word应用程序
wordApp.Quit
' 输出总页数
MsgBox "Total pages in Word files: " & totalPages
End Sub知道原因的大佬可以评论一下
计算结果
我计算了5025页，商家的软件只计算了 4699页！看来还是挺良心的。
顺藤摸瓜，我问了商家他们说是老板买软件计算的，这个是打印软件的官网https://www.nprint.cn/，这让我感觉到需求无处不在啊！
软件报价
后话
至于计算为什么不一样，我也联系和软件官方账号询问他们的计算算法是否有差异，目前还没回复。