20171024xlVBA批量获取PPT\WORD\PDF页数

Public Sub ModifyFileNames()
    Dim FolderPath As String
    Dim FileNames As Variant

    Dim dotPos As Long
    Dim ExtName As String
    Dim RealName As String
    Dim NewFile() As String
    ReDim NewFile(1 To 1) As String
    Dim Index As Long
    
    Dim StartTime As Variant
    Dim UsedTime As Variant
    StartTime = VBA.Timer
    
    

    'Set ppApp = CreateObject("Powerpoint.Application")
  
    
    
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ThisWorkbook.Path & "\"
        .AllowMultiSelect = False
        .Title = "请选取Excel工作簿所在文件夹"
        If .Show = -1 Then
            FolderPath = .SelectedItems(1)
        Else
            MsgBox "您没有选中任何文件夹，本次汇总中断！"
            Exit Sub
        End If
    End With
    
    If Right(FolderPath, 1) <> Application.PathSeparator Then FolderPath = FolderPath & Application.PathSeparator
    
    FileNames = FsoGetFiles(FolderPath, "*PDF*|*DOC*|*PPT*")
    Index = 0
    For n = LBound(FileNames) To UBound(FileNames) Step 1
        Debug.Print FileNames(n)
        Index = Index + 1
        ReDim Preserve NewFile(1 To Index)
        FilePath = FileNames(n)
        If UCase(FileNames(n)) Like "*.PD