Sub File_Deatils()
Dim fldr As FileDialog
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo 10
sItem = .SelectedItems(1)
End With
10: path = sItem & "\*.xls*"
Cells.ClearContents
cdir = path
Sheet1.Name = "Excel File Details"
Sheet1.Range("A1") = sItem
Sheet1.Range("A3") = "No."
Sheet1.Range("B3") = "File Name"
Sheet1.Range("C3") = "No of Worksheets"
Sheet1.Range("D3") = "No of Print Pages"
Dim tgt As Worksheet, r As Long
Set tgt = Sheet1
r = 0
Dim f As String
f = Dir(path)
Dim wb As Workbook, ws As Worksheet
Dim iTotPages As Integer
Do Until f = ""
If f <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(sItem & "\" & f, ReadOnly:=True)
r = r + 1
iTotPages = 0
For Each ws In wb.Sheets
ws.Activate
iTotPages = iTotPages + ActiveSheet.PageSetup.Pages.count
Next
tgt.Cells(r + 3, 1) = r
tgt.Cells(r + 3, 2) = wb.Name
tgt.Cells(r + 3, 3) = wb.Worksheets.count
tgt.Cells(r + 3, 4) = iTotPages
wb.Close savechanges:=False
End If
f = Dir()
Loop
MsgBox r & " : files found in folder"
End Sub