[VBA] To list all files in folder along with hyperlinks.

ListFilesInFolderWithHyperlink.bas

Sub MainList()
    Dim xDir As String
    xDir = Range("root_url").Value
    'MsgBox xDir
    Call clearList
    
    Application.ScreenUpdating = False
        Call ListFilesInFolder(xDir, True)
    Application.ScreenUpdating = True
    MsgBox "All files has been listed"
End Sub

Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
    'Set a reference to Microsoft Scripting Runtime by using
    'Tools > References in the Visual Basic Editor (Alt+F11)
  
    Dim xFileSystemObject As Object
    Dim xFolder As Object
    Dim xSubFolder As Object
    Dim xFile As Object
    Dim rowIndex, seqNum As Long
    
    Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFileSystemObject.GetFolder(xFolderName)
    rowIndex = Application.ActiveSheet.Range("A65536").End(xlUp).Row + 2
    
    seqNum = 1
    For Each xFile In xFolder.Files
      Application.ActiveSheet.Cells(rowIndex, 1).Formula = seqNum
      Application.ActiveSheet.Cells(rowIndex, 2).Formula = GetFilenameWithoutExtension(xFile.Name)
      Application.ActiveSheet.Hyperlinks.Add Cells(rowIndex, 3), xFile.Path, , , "Click"
      Application.ActiveSheet.Cells(rowIndex, 4).Formula = xFolder.Name
      Application.ActiveSheet.Cells(rowIndex, 5).Formula = xFile.Type
      Application.ActiveSheet.Cells(rowIndex, 6).Formula = xFile.DateCreated
      Application.ActiveSheet.Cells(rowIndex, 7).Formula = xFile.DateLastModified
      Application.ActiveSheet.Cells(rowIndex, 8).Formula = GetFileOwner(xFolder.Path, xFile.Name)
      seqNum = seqNum + 1
      rowIndex = rowIndex + 1
    Next xFile
    
    If xIsSubfolders Then
      For Each xSubFolder In xFolder.SubFolders
        ListFilesInFolder xSubFolder.Path, True
      Next xSubFolder
    End If
    
    Set xFile = Nothing
    Set xFolder = Nothing
    Set xFileSystemObject = Nothing
End Sub

Function GetFileOwner(ByVal xPath As String, ByVal xName As String)
    Dim xFolder As Object
    Dim xFolderItem As Object
    Dim xShell As Object
    
    xName = StrConv(xName, vbUnicode)
    xPath = StrConv(xPath, vbUnicode)
    Set xShell = CreateObject("Shell.Application")
    Set xFolder = xShell.Namespace(StrConv(xPath, vbFromUnicode))
    
    If Not xFolder Is Nothing Then
      Set xFolderItem = xFolder.ParseName(StrConv(xName, vbFromUnicode))
    End If
    
    If Not xFolderItem Is Nothing Then
      GetFileOwner = xFolder.GetDetailsOf(xFolderItem, 10)
    Else
      GetFileOwner = ""
    End If
    
    Set xShell = Nothing
    Set xFolder = Nothing
    Set xFolderItem = Nothing
End Function

Function GetFilenameWithoutExtension(ByVal FileName)
  Dim Result, i
  Result = FileName
  i = InStrRev(FileName, ".")
  If (i > 0) Then
    Result = Mid(FileName, 1, i - 1)
  End If
  GetFilenameWithoutExtension = Result
End Function

Sub clearList()
    Dim rowIndex As Long
    rowIndex = Application.ActiveSheet.Range("A65536").End(xlUp).Row
    
    Range("A5" & ":H" & rowIndex).ClearContents
End Sub