This set of Sub's builds a utility that searches for files in the current directory, current plus all the subs or your choice with a default directory option. It tells you the number of files found and then populates a sheet with the drive, path and file name. The last sub deletes the displayed log on the sheet. My application uses form buttons to the right of the screen to activate each sub. This should get you started you will need to add the code to also display the sheet names or filter for the wanted sheet. JSW
Sub FilesInDirectory()
Dim lngCellCounter As Long
'Search current directory for all files.
Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeExcelWorkbooks
.LookIn = CurDir()
.SearchSubFolders = False
If .Execute() > 0 Then
MsgBox "There were " & .FoundFiles.Count & " file(s) found."
For lngCellCounter = 1 To .FoundFiles.Count
Cells(lngCellCounter, 1) = .FoundFiles(lngCellCounter)
Sheets("Sheet1").Select
Next lngCellCounter
Range("A1").Select
Selection.EntireRow.Insert
Range("AA2").Select
Selection.Copy
Range("A1").Select
ActiveSheet.Paste
Else
MsgBox "No Excel WorkBooks found!"
End If
End With
Application.ScreenUpdating = True
End Sub
Sub GetAllFiles()
Dim lngCellCounter As Long
'Search all subdirectories of the current directory.
Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeExcelWorkbooks
.LookIn = CurDir()
.SearchSubFolders = True
If .Execute() > 0 Then
MsgBox "There were " & .FoundFiles.Count & " file(s) found."
For lngCellCounter = 1 To .FoundFiles.Count
Cells(lngCellCounter, 1) = .FoundFiles(lngCellCounter)
Sheets("Sheet1").Select
Next lngCellCounter
Range("A1").Select
Selection.EntireRow.Insert
Range("AA2").Select
Selection.Copy
Range("A1").Select
ActiveSheet.Paste
Else
MsgBox "No Excel WorkBooks found!"
End If
End With
Application.ScreenUpdating = True
End Sub
Sub Look_In_x()
Dim lngCellCounter As Long
Dim Message, Title, Default, MyDir
'Search current directory for all files.
Application.ScreenUpdating = False
Message = "Enter the directory to search?" & Chr(13) & Chr(13) & "(Drive:DirectorySubDirectory)" ' Set prompt.
Title = "Enter: Drive and Path!" ' Set title.
Default = "H:UsersRW155JW" ' Set default.
' Display message, title, and default value.
On Error GoTo myErr
MyDir = InputBox(Message, Title, Default)
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeExcelWorkbooks
.LookIn = MyDir
.SearchSubFolders = True
If .Execute() > 0 Then
MsgBox "There were " & .FoundFiles.Count & " file(s) found."
For lngCellCounter = 1 To .FoundFiles.Count
Cells(lngCellCounter, 1) = .FoundFiles(lngCellCounter)
Sheets("Sheet1").Select
Next lngCellCounter
Range("A1").Select
Selection.EntireRow.Insert
Range("AA2").Select
Selection.Copy
Range("A1").Select
ActiveSheet.Paste
Else
MsgBox "No Excel WorkBooks found!"
End If
End With
Application.ScreenUpdating = True
End
myErr:
MsgBox "No Excel WorkBooks found!"
End Sub
Sub Delete_Data()
'Delete the current screen print of file data.
Application.ScreenUpdating = False
Columns("A:A").Select
Selection.ClearContents
Range("A1").Select
Selection.EntireRow.Delete
Range("C1").Select
Application.ScreenUpdating = True
End Sub