求助如何获取文件夹下所有文档的页数？

赵晓鹃

一个文件夹下有多个WORD文档，有两个问题一直困扰着我，恳请各位大虾帮助：

1.获取该文件夹下所有WORD文档的总页数，并在文件夹名称后标明该文件夹“共X页”
2.分别获取该文件夹下每一个WORD文档的页数，并在相应的文件名称后标明该文档“共X页”


恳请大虾赐助，谢谢。


..................................
今天早上好大的雨呀，起床一看漆黑一片，刚刷完牙就开始电闪雷鸣，我今天迟到了，呜呜。。。。。。。

dsmch

这个也能实现？关注。
假如文档没有插入页码，从哪里入手？个人认为，最好的办法让手下手工查找再标明。

赵晓鹃

真的不能实现吗？  呜呜  命苦，命苦啊

守柔

原帖由 赵晓鹃 于 2010-8-6 09:56 发表
一个文件夹下有多个WORD文档，有两个问题一直困扰着我，恳请各位大虾帮助：

1.获取该文件夹下所有WORD文档的总页数，并在文件夹名称后标明该文件夹“共X页”
2.分别获取该文件夹下每一个WORD文档的页数，并在相应 ...

主要过程如下，如需遍历文件夹，可自行修改。
Option Explicit

Sub FolderPagesCount()
    Dim myDialog As FileDialog
    Dim myDoc As Document
    Dim FSO As Object
    Dim F As Object
    Dim FS As Object
    Dim FC As Object
    Dim F1 As Variant
    Dim astrCurArray() As String
    Dim L As Long
    Dim K As Long
    Dim lngPage As Long
    Dim lngPages As Long
    Dim strFileName As String
    Dim strFolderSpec As String
    Dim strName As String
    Set myDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With myDialog
        If .Show <> -1 Then Exit Sub
        strFolderSpec = .SelectedItems(1)
    End With
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set F = FSO.GetFolder(strFolderSpec)
    Set FC = F.Files
    For Each F1 In FC
        strName = F1.Name
        If IsWordDocument(strName) Then
            ReDim Preserve astrCurArray(L)
            astrCurArray(L) = strName
            L = L + 1
        End If
    Next
    Set FC = Nothing
    Set F = Nothing
    Set FSO = Nothing
    L = L - 1
    ReDim astrNewArray(L)
    Application.ScreenUpdating = False
    For K = 0 To L
        strFileName = strFolderSpec & "\" & astrCurArray(K)
        Set myDoc = Documents.Open(FileName:=strFileName, Visible:=False, AddToRecentFiles:=False)
        With myDoc
            lngPage = .Content.Information(wdNumberOfPagesInDocument)
            lngPages = lngPages + lngPage
            .Close False
        End With
        strName = Replace$(astrCurArray(K), ".doc", "_共" & lngPage & "页.doc", , , vbTextCompare) '''如果Doc文档有多种类型,请修改本行代码
        strName = strFolderSpec & "\" & strName
        Name strFileName As strName
    Next
    Application.ScreenUpdating = True
    If lngPages > 0 Then
        Name strFolderSpec As strFolderSpec & "_共" & lngPages & "页"
        MsgBox "已完成文档页数统计和重命名工作！", vbInformation, "Rousoft Office技术服务中心"
    End If
End Sub

Private Function IsWordDocument(FileName As String) As Boolean
'''此处可根据情况添加Word文档文件类型
    Dim strType As String
    strType = Right$(FileName, 5)
    IsWordDocument = (InStr(1, strType, ".doc", vbTextCompare) > 0)
End Function

tangqingfu

谢谢守版，收藏备用！

欣语

huguifang

标记一下，，，，

x332553761

标记一下，明天来学习

☆☆☆☆

这里提示下标越界，

☆☆☆☆

守柔 发表于 2010-8-28 15:50
主要过程如下，如需遍历文件夹，可自行修改。
Option Explicit

版主，麻烦看看这里   下标越界。