VBA - faster way to list out files in a folder & subfolders

Question

I have written a VBA code in excel (basically through combining various codes from others -_-") to list out the path, file name, file size & extension of all files under a folder and the sub-folders there-under.

Is it possible to improve the efficiency for collecting the same info?

Sub MainList()
    Set folder = Application.FileDialog(msoFileDialogFolderPicker)
    If folder.Show <> -1 Then Exit Sub
    xDir = folder.SelectedItems(1)
    Cells(3, 1) = Now()
    Call ListFilesInFolder(xDir, True)
    Cells(5, 1) = Now()
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

Answer 1

Variables

Always turn on Option Explicit. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know.

When you don't define your variable, VBA will declare it as a Variant, which are objects:

Performance. A variable you declare with the Object type is flexible enough to contain a reference to any object. However, when you invoke a method or property on such a variable, you always incur late binding (at run time). To force early binding (at compile time) and better performance, declare the variable with a specific class name, or cast it to the specific data type.

By not declaring variables, you could possibly be paying a penalty.

You didn't define folder or xDir in MainList.

Your variables in ListFilesInFolder are not really adhering to Standard VBA naming conventions. Why are these prefaced by x? There doesn't seem to be a reason. Also, using the underscore in a variable should be avoided unless it's a constant.

Dim folder_index As Integer

Integers - integers are obsolete. According to msdn VBA silently converts all integers to long.

Referencing

Every time you use Cells or Range without an explicit reference, it is implicitly referencing the active sheet. You want Sheet1.Range etc

Be sure to avoid things like .Select - it just slows the code down by needing to fiddle with the spreadsheet while doing everything else behind the scenes. There's a good question on StackOverflow addressing this.

Take this for instance -

Cells(rowIndex, 6).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=xFolder.Path, 
TextToDisplay:=xFolder.Path

The same thing could just be written directly -

 ActiveSheet.Cells(rowIndex, 6).Hyperlinks.Add Address:=xFolder.Path, TextToDisplay:=xFolder.Path

    Cells(rowIndex, 8).Formula = file_type
    Cells(rowIndex, 9).Formula = xFile.Size
    Cells(rowIndex, 10).Formula = xFile.DateLastModified
    Cells(rowIndex, 11).Formula = file_extension

Why are you setting these values via a formula? You want to use the Cells().Value property when assigning a value.

What are you doing here -

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

Are you just getting the last row? There is a standard way to find lastRow and lastColumn. That post explains why.

---

Your If structure here -

    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

Why are you doing this? First, if you need to only know those files, then you would use your Else value to filter out files that aren't what you need and then not print them. In which case a Select Case would work. But, in general, this seems unnecessary when you could just use something like

Dim fileName As String
fileName = Dir("C:\Temp" & "\*")
Do While Len(fileName) > 0     
    'here fileName = filename.filetype
    fileName = Dir
Loop

You can avoid that entire if structure by just parsing your file name

    baseName = Left(fileName, Len(fileName)-4)
    extention = Right(fileName, 3)

Though in general you'd be better off parsing it like

    Dim delimiterPosition As Long
    delimiterPosition = InStr(1, fileName, ".")

But your call.

---

Another thing that's slow is writing to the sheet so many times. Instead, gather your data into an array, populate the array, and then write it all to the sheet. Since you're creating hyperlinks, you'd store that data in your array as well.

Answer 2

I just realized the code will run much faster by setting Application.Settings to false. Is there any way to further enhance the efficiency?

Here is the revised codes...

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