List all files in directory in an Excel file

I tweaked Leith's code to insert all the found files. It was just a matter of moving 2 lines of code in the Do Loop.

Sub Test_CreateFileList()
  Dim a
  a = CreateFileList("x:\Workbooks\")
  ActiveSheet.UsedRange.ClearContents
  Range("A1").Resize(UBound(a) + 1).value = WorksheetFunction.Transpose(a)
End Sub


Function CreateFileList(ByVal FolderPath As String, Optional ByVal FileType As String, Optional ByVal FileFilter As String) As Variant

  Dim Cnt As Long
  Dim FileList() As String
  Dim FileName As String

    On Error GoTo OutOfHere
    
    If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
    If FileType = "" Then
       FileType = ".*"
    Else
       If Left(FileType, 1) <> "." Then FileType = "." & FileType
    End If
    If FileFilter = "" Then FileFilter = "*"
    
      FileName = Dir(FolderPath & FileFilter & FileType)
        Do While FileName <> ""
          ReDim Preserve FileList(Cnt)
          FileList(Cnt) = FileName
          FileName = Dir()
          Cnt = Cnt + 1
       Loop
      
OutOfHere:
     If Err = 0 Then CreateFileList = FileList
     On Error GoTo 0
     
End Function

That fixed her right up. Thanks, guys!!

Have a great weekend!

Here is another method just for kicks. It returns the full name. It uses the dictionary method so you would have to add the reference as I commented in the code.

Of course if you ever need to get the subfolder files too, other methods would be needed. FileSearch is the easiest but Excel2007 does not include it so other alternatives are needed. Of course FileSearch is easily used for subfolders and single folder methods like this as well.

Sub Test_MyFiles()
  Dim a
  a = MyFiles("x:\Workbooks", "*.xls")
  If a(0) = "NA" Then Exit Sub
  Range("A1").EntireColumn.ClearContents
  Range("A1").Resize(UBound(a) + 1).Value = WorksheetFunction.Transpose(a)
  Columns("A").Columns.AutoFit
End Sub

Function MyFiles(myFolder As String, Optional wcFiles As String = "*.*") As Variant
'Requires reference to Microsoft Scripting Runtime
  Dim cFiles As New Scripting.Dictionary
  Dim FileName As String, a() As Variant
  
  'Add trailing backslash if needed
  If Right(myFolder, 1) <> "\" Then myFolder = myFolder & "\"
  
  'Put filenames into dictionary
  FileName = myFolder & Dir(myFolder & wcFiles)
  Do While FileName <> myFolder
    cFiles.Add FileName, Nothing
    FileName = myFolder & Dir
  Loop
  
  'Return keys or items as an array
  If cFiles.Count > 0 Then
    a = cFiles.Keys
    MyFiles = a
    Else
    ReDim a(1) As Variant
    a(0) = "NA"
    MyFiles = a
  End If
  Set cFiles = Nothing
End Function