怎么统计多个WORD文档的文件名和页数

1042271867

各位老师：求助怎么统计文件夹中多个WORD文档的文件名和页数，文件名后面不要加后缀名，谢谢。

1042271867

原来一位老师写的一个提取PDF文档的，但我修改后只能提取名字，不能统计页数 。原来提取PDF的代码，表格里有。谢谢

1042271867

感谢

1042271867

Option Explicit

Sub AutoPageCount()
    Dim I As Long
    Dim xRg As Range
    Dim xStr As String
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Dim xFileNum As Long
    Dim RegExp As Object
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.PDF*", vbDirectory) 'myPath
        Set xRg = Range("A1")
        Range("A:B").ClearContents
        Range("A1:B1").Font.Bold = True
        xRg = "名称"
        xRg.Offset(0, 1) = "页数"
        I = 2
        xStr = ""
        Do While xFileName <> ""
            Cells(I, 1) = xFileName
            Set RegExp = CreateObject("VBscript.RegExp")
            RegExp.Global = True
            RegExp.Pattern = "/Type\s*/Page[^s]"
            xFileNum = FreeFile
            Open (xFdItem & xFileName) For Binary As #xFileNum
                xStr = Space(LOF(xFileNum))
                Get #xFileNum, , xStr
            Close #xFileNum
            Cells(I, 2) = RegExp.Execute(xStr).Count
            I = I + 1
            xFileName = Dir
        Loop
        Columns("A:B").AutoFit
    End If
   
End Sub

这个是原来的提取PDF代码，请老师有时间时帮我修改成提取WORD的文件名和页码

1042271867

自己顶顶............

1042271867

wengjl

Sub 统计每个word文档的页数()
    ' https://club.excelhome.net/thread-1660888-1-1.html
    ' 2023-4-27,星期四， 经搜索、拼凑调试。最终测试成功 。统计字数的没成功。
    Application.DisplayAlerts = False       ' 关闭对话框
    Set word = VBA.CreateObject("word.application")
    word.Visible = True
    myPath = ThisWorkbook.Path & "\"      ' 这个工作簿的路径
    myname = ThisWorkbook.Name            ' 这个工作簿的名称
   
    x1 = 2
    Do While Not (IsEmpty(Sheet1.Cells(x1, 2).Value))   ' 对前一个SUB获取的WORD文档数据进行循环
      fname = myPath & Cells(x1, 2).Value               ' 将WORD文档名存入变量中
   
        Set myword = word.documents.Open(fname)         ' 打开WORD文档
        pn = myword.ActiveWindow.ActivePane.Pages.Count ' 对页数进行统计   
        word.documents.Close False                      ' True 关闭WORD窗口
        Windows(myname).Activate    ' 切换到EXCEL窗口
        Cells(x1, 3).Value = pn     ' 记录页数
        
      x1 = x1 + 1
    Loop
    word.Application.Quit
    Set myword = Nothing
    Application.DisplayAlerts = True       ' 恢复对话框
   
End Sub

wengjl

论坛的版主，能否给个 统计WORD文档字数的语句？

1042271867

wengjl 发表于 2023-4-27 12:43
论坛的版主，能否给个 统计WORD文档字数的语句？

我在网上看到这个里面有统计字数的，但只能统计一个文档，你看看有用不

1042271867

wengjl 发表于 2023-4-27 11:00
Sub 统计每个word文档的页数()
    ' https://club.excelhome.net/thread-1660888-1-1.html
    ' 2023-4 ...

我显示的是这个，不知怎么解决，谢谢