Sub MainList()

Application.ScreenUpdating = False

Application.EnableEvents = False

Application.DisplayAlerts = False

Application.Calculation = xlCalculationManual

Set folder = Application.FileDialog(msoFileDialogFolderPicker)

If folder.Show <> -1 Then Exit Sub

xDir = folder.SelectedItems(1)

Call ListFilesInFolder(xDir, True)

Application.ScreenUpdating = True

Application.DisplayAlerts = True

Application.EnableEvents = True

Application.Calculation = xlCalculationAutomatic

End Sub

Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)

Dim xFileSystemObject As Object

Dim xFolder As Object

Dim xSubFolder As Object

Dim xFile As Object

Dim rowIndex As Long

Dim folder_index As Integer

Dim file_extension As String

Dim file_type As String

Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")

Set xFolder = xFileSystemObject.GetFolder(xFolderName)

folder_index = Range("B65536").End(xlUp).Row + 1

rowIndex = Range("F65536").End(xlUp).Row + 1

Cells(folder_index, 2).Select

ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=xFolder.Path, TextToDisplay:=xFolder.Path

For Each xFile In xFolder.Files

file_extension = LCase(xFileSystemObject.GetExtensionName(xFile.Path))

If file_extension = "pdf" Then

file_type = "PDF"

ElseIf Left(file_extension, 3) = "doc" Then

file_type = "DOC"

ElseIf Left(file_extension, 2) = "xl" Then

file_type = "XLS"

ElseIf Left(file_extension, 3) = "msg" Then

file_type = "MSG"

ElseIf Left(file_extension, 3) = "zip" Then

file_type = "ZIP"

ElseIf Left(file_extension, 3) = "ppt" Then

file_type = "PPT"

Else

file_type = ""

End If

Cells(rowIndex, 6).Select

ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=xFolder.Path, TextToDisplay:=xFolder.Path

Cells(rowIndex, 7).Select

ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=xFile.Path, TextToDisplay:=xFile.Name

Cells(rowIndex, 8).Formula = file_type

Cells(rowIndex, 9).Formula = xFile.Size

Cells(rowIndex, 10).Formula = xFile.DateLastModified

Cells(rowIndex, 11).Formula = file_extension

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