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 = "A:" ' 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
This code will look for Excel workbooks on drive A: by default and print a list on sheet1 starting in cell A1 (Note: Cell AA2 could contain a title like: "This is the list of indicated files!"). You can also select any other drive or path?
This last code will delete the posted list of files from the workbook containing the above code. Hope this helps. JSW
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