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.

• i.c: Thanks a lot! After storing hyperlinks in the array, is it possible to "write" such hyperlinks together with other data at once?
• Raystafarian: I don't know of a way to write hyperlinks out of an array to all the cells at once, but a loop should suffice

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