Retrieve File names from a folder with last modified username

Hi Patel45
Thanks for your reply Module2.DirLoop doesn't need for my requirement(i used just for testing the code in different way) , my code was not finished and also not in good format, it may confuse you ..... Any way if you get an idea to retrieve Username of Last Modified User for a file in a specified folder ..
Thanks in Advance

'sheet1
Public Sub CommandButton2_Click()
Range("B12:F1000").ClearContents
Range("C10:F10").Value = ""
End Sub


'Module 2:

Option Compare Text
Option Explicit
Public Directory As Object


'Program to remove unwanted file names
Function Excludes(Ext As String) As Boolean
     'Function purpose:  To exclude listed file extensions from hyperlink listing
     
    Dim X, NumPos As Long
     
     'Enter/adjust file extensions to EXCLUDE from listing here:
    X = Array("ini", "$")
     
    On Error Resume Next
    NumPos = Application.WorksheetFunction.Match(Ext, X, 0)
    'MsgBox NumPos & ">"
    If NumPos > 0 Then Excludes = True
    On Error GoTo 0
     
End Function


'To retrieve file hyperlink and File size

Sub HyperlinkFileList()
     
    Dim fso As Object, _
    ShellApp As Object, _
    File As Object, _
    SubFolder As Object, _
    Directory As String, _
    Problem As Boolean, _
    ExcelVer As Integer
     Call Sheet1.CommandButton2_Click
     'Turn off screen flashing
    Application.ScreenUpdating = False
     
    Set fso = CreateObject("Scripting.FileSystemObject")

    Do
        Problem = False
        Set ShellApp = CreateObject("Shell.Application").BrowseForFolder(0, "Please choose a folder", 0, "c:\\")
         
        On Error Resume Next
        Directory = ShellApp.self.Path
        Sheet1.Range("D10").Value = Directory
    Call Module2.DirLoop
        Set SubFolder = fso.GetFolder(Directory).Files
        If Err.Number <> 0 Then
            If MsgBox("You did not choose a valid directory! Or Folder may be Empty!" & vbCrLf & _
            "Would you like to try again?", vbYesNoCancel, _
            "Directory Required") <> vbYes Then Exit Sub
            Problem = True
        End If
        On Error GoTo 0
    Loop Until Problem = False
     

    With ActiveSheet
        With .Range("D9")
                .Parent.Hyperlinks.Add _
                Anchor:=.Offset(1, 0), _
                Address:=Directory, _
                TextToDisplay:=Directory
        End With
    End With
     
     'Adds each file, details and hyperlinks to the list
    For Each File In SubFolder
        If Not Excludes(Right(File.Path, 3)) = True Then
        If Not Excludes(Mid(File.Name, 1, 2)) = True Then
            With ActiveSheet
                    .Hyperlinks.Add _
                    Anchor:=ActiveSheet.Range("D65536").End(xlUp).Offset(1, 0), _
                    Address:=File.Path, _
                    TextToDisplay:=File.Name
                  
                With .Range("F65536").End(xlUp)
                    With .Offset(1, 0)
                        .Value = WorksheetFunction.Round(File.Size / 1024, 2)
                        .NumberFormat = "#,##0.00"
                    End With
                End With
            End With
            End If
        End If
    Next
    

     
End Sub



'Module2
'to retrieve only File name and Last Modified date

Sub DirLoop()
On Error Resume Next
Dim fso As Object, _
    ShellApp As Object, _
    File As Object, _
    SubFolder As Object, _
    Directory As String, _
    Problem As Boolean, _
    ExcelVer As Integer
    Set fso = CreateObject("Scripting.FileSystemObject")

Sheet1.Range("B12:F1000").ClearContents
Dim MyFile As String, Sep As String, datefile As String
Sep = Application.PathSeparator
If Sep = "\" Then
MyFile = Dir(Sheet1.Range("D10").Value & Sep & "*.*")
End If
datefile = FileDateTime(Sheet1.Range("D10").Value & "\" & MyFile)

Dim i, j As Integer
i = 12
j = 1
Do While MyFile <> ""
Sheet1.Cells(i, 2).Value = j
Sheet1.Cells(i, 3).Value = MyFile

j = j + 1
i = i + 1
datefile = FileDateTime(Sheet1.Range("D10").Value & "\" & MyFile)
Sheet1.Cells(i - 1, 5).Value = datefile
MyFile = Dir()

Loop

End Sub