Search for specific sheet in closed W/B

[RWinfield]

Seems like the code for this was posted a while ago, but it's Friday and I seem to not be able to locate it.

What I am trying to do is to use an input box to have the user enter a sheet name and then have Excel search the workbooks in a certain directory for that sheet, then open the sheet.

Any help would be appreciated.

Rick

 

[Joe Was]

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