Sub ExtractFileNamesAndPageNumbers()
    Dim Path As String
    Dim fileNames() As String
    Dim FileCount As Integer
    Dim FileIndex As Integer
    Dim PageNumber As String
    
    ' Get folder path from user
    Path = InputBox("Enter Files Path")
    Path = Path & "\"
    
    ' Check if path exists
    If Dir(Path, vbDirectory) = "" Then
        MsgBox "Invalid folder path. Please try again.", vbExclamation
        Exit Sub
    End If
    
    ' Get all file names in the folder
    FileCount = 0
    ReDim fileNames(1 To 1)
    If Right$(Path, 1) <> "\" Then Path = Path & "\"
    Filename = Dir$(Path & "*.*", vbNormal)
    Do Until Filename = ""
        If (GetAttr(Path + Filename) And vbDirectory) = vbNormal Or (GetAttr(Path + Filename) And vbHidden) = vbHidden Or (GetAttr(Path + Filename) And vbSystem) = vbSystem Then
            FileCount = FileCount + 1
            ReDim Preserve fileNames(1 To FileCount)
            fileNames(FileCount) = Filename
        End If
        Filename = Dir$
    Loop
    
    ' Set up Excel sheet
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets.Add
    
    ' Add headers
    ws.Cells(1, 1).Value = "File Name"
    ws.Cells(1, 2).Value = "Page Number"
    
    ' Loop through file names and extract page numbers
    For FileIndex = 1 To FileCount
        ' Extract page number from file name
        PageNumber = Mid(fileNames(FileIndex), InStrRev(fileNames(FileIndex), ".") + 1)
        
        ' Copy file name and page number to Excel sheet
        ws.Cells(FileIndex + 1, 1).Value = fileNames(FileIndex)
        ws.Cells(FileIndex + 1, 2).Value = PageNumber
    Next FileIndex
    
    ' Autofit columns
    ws.Columns.AutoFit
    
    MsgBox "File names and their page numbers have been extracted successfully.", vbInformation
End Sub