Reading in the files in a directory into an array, directory chosen by user

**welchs101** · 05-17-2011, 10:29 PM

HI,

I have some qty of excel files. All the files are the same except for the name. I need to open each file and copy the data. I will paste the data from each file into a single file.

What i was wondering is does anyone have a good program to do the following:

1) User selects a diretory
2) After directory selected you populate the array with all the excel files in the directory

any help would be appreaciated. thanks.

**Leith Ross** · 05-18-2011, 02:26 AM

Hello welchs101,

Here is macro to allow the user to select a directory and return all ".xls" files in the folder. If no Excel files are found then a message is displayed indicating this and the macro quits.

Function ReturnFileList() As Variant

  Dim Cnt As Long
  Dim ExcelFiles() As Variant
  Dim FilePath As String
  Dim FileName As String
  Dim objShell As Object
    
    Set objShell = CreateObject("Shell.Application")
    
    Set oFolder = objShell.BrowseForFolder(0, "Pick a Folder to Open", 0)
    If oFolder Is Nothing Then Exit Function
    
      FilePath = oFolder.Self.Path & "\"
      
      FileName = Dir(FilePath & "*.xls")
      If FileName = "" Then
         MsgBox "No Excel Files were Found in this Folder.", vbCritical
         Exit Function
      End If
      
        Do While FileName <> ""
          ReDim Preserve ExcelFiles(Cnt)
          ExcelFiles(Cnt) = FilePath & FileName
          Cnt = Cnt + 1
          FileName = Dir()
        Loop
    
    ReturnFileList = ExcelFiles
    
End Function

**welchs101** · 05-18-2011, 05:44 AM

Hi Leith Ross,

Nice! Works great!!!!!!!!!!!!!!!!!

Thanks alot!

Few quick questions:

1) To call this function do i have to create an array of type variant or can it be an array of type string?

2) The entries in the array have the full "Path" as well as the actual file. How do i strip out just the file itself from the string..........if you know a quick fix please let me know. The stripping out the file name only can be done in a separate array if you want.

Thanks again........your soln works great!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

**welchs101** · 05-18-2011, 09:56 AM

Just noticed that when i put this into my actual program.........i get an error. Apparently in my program i have at the top of the macro

Option Base 1

Apparently in this program your starting at "0" .....how to change your code so that it starts from "1"?

**welchs101** · 05-18-2011, 09:59 AM

ok...i just added cnt=1 prior to the Do loop

      Cnt = 1
        Do While FileName <> ""

and now it starts at 1.

thanks.

**Leith Ross** · 05-18-2011, 12:52 PM

Hello Welchs101,

The array passed back the function is a Variant that contains strings. If there are no files found then the return value will be "empty". The returned array is a 1-D array.

Here is an example of listing the returned files in column "A" of the active sheet:

  Dim ExcelFiles As Variant
  Dim Rng As Range

    If Not IsEmpty(ExcelFiles) Then
       Set Rng = Range("A1").Resize(RowSize:=UBound(ExcelFiles))
       Rng.Value = WorksheetFunction.Transpose(ExcelFiles)        
    End If

Updated Macro

Function ReturnFileList() As Variant

  Dim Cnt As Long
  Dim ExcelFiles() As Variant
  Dim FilePath As String
  Dim FileName As String
  Dim objShell As Object
    
    Set objShell = CreateObject("Shell.Application")
    
    Set oFolder = objShell.BrowseForFolder(0, "Pick a Folder to Open", 0)
    If oFolder Is Nothing Then Exit Function
    
      FilePath = oFolder.Self.Path & "\"
      
      FileName = Dir(FilePath & "*.xls")
      If FileName = "" Then
         MsgBox "No Excel Files were Found in this Folder.", vbCritical
         Exit Function
      End If
      
        Do While FileName <> ""
          Cnt = Cnt + 1 
          ReDim Preserve ExcelFiles(Cnt)
          ExcelFiles(Cnt) = FileName
          FileName = Dir()
        Loop
    
    ReturnFileList = ExcelFiles
    
End Function