VBA to Open Multiple Excel Files

Hello nrxanders,

there are 2 macros. One is complete and the other is not. The macro to recursively find all files on a drive is finished. The second macro opens the Excel workbooks (.xls or .xlsx), However the code to to retrieve the data and store it is missing. you didn't post that information and I didn't request it. So, you can either add that code or tell me what data you need and where it it will be saved.

Macro to Recursively List Files

'Written: December 06, 2010
'Author:  Leith Ross
'Summary: List files in a directory or all of its subdirectories that match
'         the file name pattern. This uses only VBA and no scripting languages.


Public Function ListFiles(ByRef colFiles As Collection, _
                          ByVal FolderPath As String, _
                          ByVal FileSpec As String, _
                          ByVal SearchSubfolders As Boolean)

  Dim FileName As String
  Dim colFolders As New Collection
  Dim vFolderName As Variant

   'Add files in FolderPath matching FileSpec to colFiles
    FolderPath = IIf(Right(FolderPath, 1) <> "\", FolderPath & "\", FolderPath)
    FileName = Dir(FolderPath & FileSpec)
    Do While FileName <> ""
        colFiles.Add FolderPath & FileName
        FileName = Dir
    Loop

    If SearchSubfolders Then
       'Fill colFolders with list of Subdirectories in FolderPath
        SubFolder = Dir(FolderPath, vbDirectory)
        Do While SubFolder <> ""
            If (SubFolder <> ".") And (SubFolder <> "..") Then
                If (GetAttr(FolderPath & SubFolder) And vbDirectory) <> 0 Then
                    colFolders.Add SubFolder
                End If
            End If
            SubFolder = Dir
        Loop

        'Call ListFiles for each subfolder in colFolders
        For Each vFolderName In colFolders
            Call ListFiles(colFiles, FolderPath & vFolderName, FileSpec, True)
        Next vFolderName
    End If

End Function

Macro (incomplete) to Open and Save the Workbook Data

Sub GetExcelData()
    
  Dim colFiles As New Collection
  Dim FileItem As Variant
  Dim Wkb As Workbook
  
    ListFiles colFiles, "C:\", "*.xls*", True

    For Each FileItem In colFiles
      Set Wkb = Worksbooks.Open(FileItem)
        'Data to get information from worksheet and save it
      Wkb.Close
    Next FileItem
    
End Sub