getting worksheetnames from subfolders

[Guest]

hi,
I added below code, but I cannot see worksheet names from workbooks in sub
folders ? what is the problem ?

..SearchSubFolders = IncludeSubFolder

for example
I can get the names from d:\1\*.xls , d:\1\2\*.xls
but I cannot see the name of a worksheet in a.xls
d:\1\2\3\a.xls





If I want to see the directory of each worksheet next to the name of it how
can we revise the code?
for example;
book ( name of worksheet ) D:\library\...a.xls

Sub GetAllWorksheetNames()
Dim i As Integer
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim wSheet As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next

Set wbCodeBook = ThisWorkbook

With Application.FileSearch
.NewSearch
.LookIn = "C:\my documents" 'amend to suit

.SearchSubFolders = IncludeSubFolder

 

[Guest]

Hi SAHRAYICEDIT-ISTANBUL:

Change
..SearchSubFolders = IncludeSubFolder

To
..SearchSubFolders = True


And your code works perfectly.

 

[Guest]

If I want to see the directory of each worksheet next to the name of it how
can we revise the code?

Modify this line of code
wbCodeBook.Sheets(1).Range _
("A65536").End(xlUp)(2, 1) = UCase(wbResults.Name)

to this line of code will give you a full path including the workbook name.

wbCodeBook.Sheets(1).Range _
("A65536").End(xlUp)(2, 1) = .FoundFiles(i)

It's a magic little routine you have. I have added it to my library for
future reference.

Regards,

OssieMac

 

[Guest]

Have been playing with the code and if you only want to display the
subfolders from the current search location instead of the full path then
that can be done also.

Here is a full new copy of the code. (Easiest way to describe)

Sub GetAllWorksheetNames()
Dim i As Integer
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim wSheet As Worksheet
Dim myCurrentPath As String
Dim myCurrentPathLgth As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

myCurrentPath = CurDir

'next line of code the plus 2 allows for backslash plus 1 for next
'start character used in the mid()function below.

myCurrentPathLgth = Len(myCurrentPath) + 2

On Error Resume Next

Set wbCodeBook = ThisWorkbook

With Application.FileSearch
.NewSearch
.LookIn = myCurrentPath 'amend to suit
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Set wbResults = Workbooks.Open(.FoundFiles(i))
wbCodeBook.Sheets(1).Range _
("A65536").End(xlUp)(2, 1) _
= Mid(.FoundFiles(i), myCurrentPathLgth)
For Each wSheet In wbResults.Worksheets
wbCodeBook.Sheets(1).Range _
("A65536").End(xlUp)(2, 1) = wSheet.Name
Next wSheet
wbResults.Close SaveChanges:=False
Next i
End If
End With

On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

 

[Guest]

Here's an additional stage in the evolution of SAHRAYICEDIT-ISTANBUL's
procedure with improvements by OssieMac. It outputs the information in a
database style list that is sorted by pathname, filename, and worksheet
order. As per the orginal, you can choose the folder (all of its subfolders
are searched), but you have to provide the starting folder by modifying the
code prior to run time.

I've tested some methods for browsing to a folder at runtime, but have not
yet been successful at implementing that option fully.
------------------------------------------------------
Sub GetAllWorksheetNames()
Dim i As Integer
Dim L As Integer
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim wbCodeBookws As Worksheet
Dim wSheet As Worksheet
Dim myFolderPath As String
Dim mySubFolderPath As String

On Error GoTo errorHandler
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

Set wbCodeBook = ThisWorkbook
Set wbCodeBookws = ActiveSheet
wbCodeBookws.Cells.Clear

Range("A1") = "WorksheetName": Range("B1") = "SheetOrder"
Range("C1") = "FileName": Range("D1") = "FolderPath"

With Application.filesearch
.NewSearch
.LookIn = "C:\Documents and Settings" '<==amend to suite
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then

For i = 1 To .FoundFiles.Count
L = InStrRev(.FoundFiles(i), "\")
mySubFolderPath = Left(.FoundFiles(i), L - 1)

If .FoundFiles(i) = ThisWorkbook.Path & "\" & ThisWorkbook.Name _
Or Mid(.FoundFiles(i), L + 1) = ThisWorkbook.Name Then _
MsgBox "This workbook found, but skipped...": GoTo skip
Set wbResults = Workbooks.Open(.FoundFiles(i))

'Lay in worksheet names
iw = 0
For Each wSheet In wbResults.Worksheets
If iw = 0 Then tRow = wbCodeBookws.Cells(Rows.Count,
1).End(xlUp)(2, 1).Row
wbCodeBookws.Cells(Rows.Count, 1).End(xlUp)(2, 1) _
= wSheet.Name
iw = iw + 1
wbCodeBookws.Cells(Rows.Count, 1).End(xlUp)(1, 2) _
= iw
Next 'wSheet
bRow = tRow + iw - 1

'Lay in workbook name and path
wbCodeBookws.Range(Cells(tRow, 3), Cells(bRow, 3)) _
= Mid(.FoundFiles(i), L + 1)
wbCodeBookws.Range(Cells(tRow, 4), Cells(bRow, 4)) _
= Left(.FoundFiles(i), L)

wbResults.Close SaveChanges:=False
skip:
Next i
End If
End With

'Sort list by folderpath, filename, and sheetorder
Range("A1").CurrentRegion.Sort Key1:=Range("D2"), _
Order1:=xlAscending, Key2:=Range("C2"), _
Order2:=xlAscending, Key3:=Range("B2"), _
Order3:=xlAscending, Header:=xlYes

wrapSub:
wbCodeBookws.Columns("A:C").AutoFit
wbCodeBookws.Cells(1, 1).Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Exit Sub

errorHandler:
MsgBox "An error occurred... action canceled."
Resume wrapSub

End Sub