Dim jg(), k&, tms#
    
Sub ListFilesFso()
    sb& = InputBox("Search Type: AllFiles=0/Files=1/Folder=-1/All Folder=-2", "Find Files", 0)
    SpFile$ = InputBox("typeoffiles", "Find Files", ".xl")
    If SpFile Like ".*" Then SpFile = LCase(SpFile) & "*"
    With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show Then myPath$ = .SelectedItems(1) Else Exit Sub
    End With
    If Right(myPath, 1) <> "" Then myPath = myPath & ""
    ReDim jg(65535, 6)
    jg(0, 0) = "Ext": jg(0, 1) = IIf(sb < 0, IIf(Len(SpFile), "Filename", "No"), "Filename")
    jg(0, 2) = "Folder": jg(0, 3) = "Path": jg(0, 4) = "Creation Date": jg(0, 5) = "Modification Date": jg(0, 6) = "File Size"
    tms = Timer: k = 0: Call ListAllFso(myPath, sb, SpFile)
    If sb < 0 And Len(SpFile) = 0 Then Application.StatusBar = "Get " & k & " Folders."
    [a1].CurrentRegion = "": [a1].Resize(k + 1, 7) = jg: [a1].CurrentRegion.AutoFilter Field:=1
        'hyperlinks in column B
        With ActiveSheet
            For Each cel In .Range("B2", .Range("B" & .Rows.Count).End(xlUp))
                .Hyperlinks.Add Anchor:=.Cells(cel.Row, cel.Column), Address:=cel.Offset(, 2) & "\" & cel & cel.Offset(, -1)
            Next cel
        End With
    Columns.AutoFit
    Intersect(ActiveSheet.UsedRange, Columns(7)).HorizontalAlignment = xlRight
End Sub
    
    
Function ListAllFso(myPath$, Optional sb& = 0, Optional SpFile$ = "")
    Set fld = CreateObject("Scripting.FileSystemObject").GetFolder(myPath)
    On Error Resume Next
    If sb >= 0 Or Len(SpFile) Then
        For Each f In fld.Files
            t = False: n = InStrRev(f.Name, ".")
            fnm = Left(f.Name, n - 1)
            x = LCase(Mid(f.Name, n))
            
            If Err.Number Then Err.Clear
    
            If SpFile = " " Then
                t = True
            ElseIf SpFile Like ".*" Then
                If x Like SpFile Then t = True
            Else
                If InStr(fnm, SpFile) Then t = True
            End If
            
            If t Then
                k = k + 1
                jg(k, 0) = x
                jg(k, 1) = "'" & fnm
                jg(k, 2) = fld.Name
                jg(k, 3) = fld.Path & "\" & fnm & x
                jg(k, 4) = f.DateCreated
                jg(k, 5) = f.DateLastModified:
                fs = f.Size
                    Select Case fs
                        Case 0 To 1023: fs = Format(fs, "0") & "B"
                        Case 1024 To 1048575: fs = Format(fs / 1024, "0") & "KB"
                        Case 1048576 To 1073741823: fs = Format(fs / 1048576, "0") & "MB"
                        Case 1073741824 To 1.11111111111074E+20: fs = Format(fs / 1073741823, "0.00") & "GB"
                    End Select
                jg(k, 6) = fs
            End If
        Next
    Application.StatusBar = Format(Timer - tms, "0.0s") & " Get " & k & " Files , Searching in Folder ... " & fld.Path
    End If
    
    For Each fd In fld.SubFolders
        If sb < 0 And Len(SpFile) = 0 Then
            k = k + 1
            jg(k, 0) = "fld"
            jg(k, 1) = k
            jg(k, 2) = fd.Name
            jg(k, 3) = fld.Path & "\" & fnm & x
            jg(k, 4) = f.DateCreated
            jg(k, 5) = f.DateLastModified
            fs = f.Size
                Select Case fs
                    Case 0 To 1023: fs = Format(fs, "0") & "B"
                    Case 1024 To 1048575: fs = Format(fs / 1024, "0") & "KB"
                    Case 1048576 To 1073741823: fs = Format(fs / 1048576, "0") & "MB"
                    Case 1073741824 To 1.11111111111074E+20: fs = Format(fs / 1073741823, "0.00") & "GB"
                End Select
            jg(k, 6) = fs
        End If
        If sb Mod 2 = 0 Then Call ListAllFso(fd.Path, sb, SpFile)
    Next
End Function