Oops, forgot to adjust the build of the hyperlinks after altering column D to be the full path, just needs to be

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
' add hyperlinks
With ActiveSheet
'hyperlinks in column B
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
'hyperlinks in column D
'For Each cel In .Range("D2", .Range("D" & .Rows.Count).End(xlUp))
'.Hyperlinks.Add Anchor:=.Cells(cel.Row, cel.Column), Address:=cel & "/" & cel.Offset(, -2) & cel.Offset(, -3), TextToDisplay:=cel.Offset(, -2).Value & cel.Offset(, -3).Value
'Next cel
End With

End Sub

Function ListAllFso(myPath$, Optional sb& = 0, Optional SpFile$ = "")
Set fld = CreateObject("Scripting.FileSystemObject").GetFold er(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) = f.Path: jg(k, 4) = f.DateCreated: jg(k, 5) = f.DateLastModified: jg(k, 6) = Format(f.Size / 1048576, "0.00MB") 'f.Size
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) = f.Path: jg(k, 4) = f.DateCreated: jg(k, 5) = f.DateLastModified: jg(k, 6) = Format(f.Size / 1048576, "0.00MB") ' f.Size
If sb Mod 2 = 0 Then Call ListAllFso(fd.Path, sb, SpFile)
Next
End Function







Very grateful for your help. The problem is solved, I wish you happiness!