List all files in directory in an Excel file

Good morning, Gurus.

In my search I found several example similar to what I need, but nothing I could adapt to filt my needs, (at least not wim my limited skills).

Here what I need to do:
I have multilple Excel files in a directory. (M:/Archived PO Responses/Domestic). On a daily basis, these files are processed via VBA, and deleted after processing. What I need to do is, prior to processing and deleting these files, create an ongoing log of the filenames in that directory.

Example:
The macro would open an Excel file named "Processed Orders.xls", which is stored on the network drive "M:". It would then append all of the filenames in the directory mentioned above to a sheet named "Processed Orders" in that workbook, below any filenames that already exist.

Thanks in advance for any help you can offer.

Hello Matt,

Here is a macro I wrote a little while ago because I needed to keep better track of my files. You can select the file type to list and do wild card matching on the file names. Copy this code into a standard module in the workbook "Processed Orders.xls". Add a button to the worksheet "Processed Orders" and attach the macro "ListFiles" to it. Here is the code...

'Written: February 19, 2009
'Author:  Leith Ross
'Summary: Creates a file list and copies it to the Active Sheet start at "A1".
'         The arguments are the directory to be searched, the file type (extension),
'         and optionally a wildcard filter for file names. Only the rquired argument
'         is the directory path.

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 <> ""
          FileName = Dir()
          ReDim Preserve FileList(Cnt)
          FileList(Cnt) = FileName
          Cnt = Cnt + 1
       Loop
      
OutOfHere:
     If Err = 0 Then CreateFileList = FileList
     On Error GoTo 0
     
End Function

Sub ListFiles()

  Dim I As Long
  Dim MyFiles As Variant
  Dim MyArray() As String
  Dim N As Long
  Dim Rng As Range
  Dim RngEnd As Range
  
    MyFiles = CreateFileList("M:/Archived PO Responses/Domestic", ".xls")
    
      N = UBound(MyFiles)
      ReDim MyArray(N, 0)
      
        For I = 0 To N
          MyArray(I, 0) = MyFiles(I)
        Next I
        
        Set Rng = Worksheets("Processed Orders").Range("A1")
        Set Rng = Cells(Rows.Count, Rng.Column).End(xlUp).Offset(1, 0)
        Set Rng = Rng.Resize(N + 1, 1)
        
        Rng = MyArray
  
End Sub

Hello Hutch,

I'll have to double check the macro. I don't see anything obvious in the code and thought it listed all the files in the tests. If the same result is happening on 2 directories then something is not right. I'll look into it.

Hello Hutch,

Found the problem. Using arrays can be confusing. Sometimes they are zero based, and other times one based.

'Written: February 19, 2009 (Updated April 03, 2009)
'Author:  Leith Ross
'Summary: Creates a file list and copies it to the Active Sheet start at "A1".
'         The arguments are the directory to be searched, the file type (extension),
'         and optionally a wildcard filter for file names. Only the rquired argument
'         is the directory path.

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 <> ""
          Cnt = Cnt + 1
          ReDim Preserve FileList(Cnt)
          FileList(Cnt) = FileName
          FileName = Dir()
       Loop
      
OutOfHere:
     If Err = 0 Then CreateFileList = FileList
     On Error GoTo 0
     
End Function

Sub ListFiles()

  Dim I As Long
  Dim MyFiles As Variant
  Dim MyArray() As String
  Dim N As Long
  Dim Rng As Range
  Dim RngEnd As Range
  
    MyFiles = CreateFileList("C:\Documents and Settings\Admin.ADMINS\My Documents", ".txt")
    
      N = UBound(MyFiles)
      ReDim MyArray(N, 0)
      
        For I = 1 To N
          MyArray(I, 0) = MyFiles(I)
        Next I
        
        Set Rng = Worksheets("Sheet2").Range("A2")
        Set Rng = Cells(Rows.Count, Rng.Column).End(xlUp)
        Set Rng = Rng.Resize(N + 1, 1)
        
        Rng = MyArray
  
End Sub