Hi

below code helps me to get all worksheetnames from different workbooks which
are in different folders.I can see all as a list in a worksheet.But I want
to see them as links, when I click any worksheet name, the workbook will be
opened.

regards.

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 = "D:\Yeni Klasör" 'amend to suit
.SearchSubFolders = True

.Filename = "*.xls"

If .Execute 0 Then
For i = 1 To .FoundFiles.Count
Set wbResults = Workbooks.Open(.FoundFiles(i))

wbCodeBook.Sheets(1).Range _
("A65536").End(xlUp)(2, 7) = UCase(wbResults.Name)

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
--
SAHRAYICEDIT-ISTANBUL

How about populating a combo dropdown box from the range and then you can set
an event to run on clicking the one you want.

Regards,

OssieMac

"excel-tr" wrote:

Hi

below code helps me to get all worksheetnames from different workbooks which
are in different folders.I can see all as a list in a worksheet.But I want
to see them as links, when I click any worksheet name, the workbook will be
opened.

regards.

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 = "D:\Yeni Klasör" 'amend to suit
.SearchSubFolders = True

.Filename = "*.xls"

If .Execute 0 Then
For i = 1 To .FoundFiles.Count
Set wbResults = Workbooks.Open(.FoundFiles(i))

wbCodeBook.Sheets(1).Range _
("A65536").End(xlUp)(2, 7) = UCase(wbResults.Name)

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
--
SAHRAYICEDIT-ISTANBUL

Hi,

it can be, but my code level is not enough to write it. I need help.

regards.
--
SAHRAYICEDIT-ISTANBUL


"OssieMac":

How about populating a combo dropdown box from the range and then you can set
an event to run on clicking the one you want.

Regards,

OssieMac

"excel-tr" wrote:

Hi

below code helps me to get all worksheetnames from different workbooks which
are in different folders.I can see all as a list in a worksheet.But I want
to see them as links, when I click any worksheet name, the workbook will be
opened.

regards.

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 = "D:\Yeni Klasör" 'amend to suit
.SearchSubFolders = True

.Filename = "*.xls"

If .Execute 0 Then
For i = 1 To .FoundFiles.Count
Set wbResults = Workbooks.Open(.FoundFiles(i))

wbCodeBook.Sheets(1).Range _
("A65536").End(xlUp)(2, 7) = UCase(wbResults.Name)

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
--
SAHRAYICEDIT-ISTANBUL

Just a bit more info on your code. I modified it yesterday so that I had the
worksheet names in one column and the sheet names in another column. That way
I am able to use autofilter to see the sheets related to a particular
workbook. Using this method might make it easier to set up a combo box so
that you can relate a sheet to the workbook (It repeats the workbook name for
each worksheet) so here is the modified code. You will also see that I have
now used CurDir instead of Default so that I can run it from any folder and
it will work for the folder it is in and any subfolders. I also had a problem
with it wanting to re-open the workbook from which I was running the macro I
had to handle that also.

Dim i As Integer 'Used in loop.
Dim j As Integer 'Used for row identifier when writing data.
Dim wbResults As Workbook 'Name of workbook found
Dim wbCodeBook As Workbook 'Holds name of this workbook
Dim currentFile As String 'Id of current file with full path
Dim wSheet As Worksheet 'Worksheet in found workbook
Dim myCurrentPath As String 'Current path of this workbook
Dim myCurrentPathLgth As Integer 'Length of path string used in Mid()
function

Sub GetAllWorksheetNames()

'This macro designed to run from the folder where it has to _
search for the files and subfolders.

Sheets("Sheet1").Select

Cells.Select
Selection.Clear

'Insert column titles
Range("A1") = "Work Book Name"
Range("B1") = "Work Sheet Name"
Range("A1:B1").Font.Bold = True
Range("A1").Select

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

myCurrentPath = CurDir
currentFile = myCurrentPath & "\" & ActiveWorkbook.Name

'Plus 2 allows backslash plus 1 for next
'start character in the mid()function below
myCurrentPathLgth = Len(myCurrentPath) + 2

Set wbCodeBook = ThisWorkbook

With Application.FileSearch
.NewSearch
.LookIn = myCurrentPath
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute 0 Then ' 0 Then files of required type exist
j = 1 'Row numbers. Initialize as 1 to allow for column headers
For i = 1 To .FoundFiles.Count
'Test that not current file in use.
If LCase(.FoundFiles(i)) < LCase(currentFile) Then
Set wbResults = Workbooks.Open(.FoundFiles(i))
For Each wSheet In wbResults.Worksheets
j = j + 1 'Sets row number
wbCodeBook.Sheets(1).Cells(j, 1) _
= Mid(.FoundFiles(i), myCurrentPathLgth)
wbCodeBook.Sheets(1).Cells(j, 2) = Format(wSheet.Name)
Next wSheet
wbResults.Close SaveChanges:=False
End If
Next i
End If
End With

Sheets("Sheet1").Select
Columns("A:B").Select
Selection.Columns.AutoFit
Range("A1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.CalculateFull

End Sub

I was posting my additional info while you were posting your reply to me. I
will be out for 5 or 6 hours but if you have not got an answer by then I will
have a look at it for you. Should not be too difficult.

Regards,

OssieMac

hi,

list will be written in the workbook that is in my computer, but workbooks
which will be searched will be in the server.can we make them as links ? if
they are not as link,I will have to find the place of file from the search.

--
SAHRAYICEDIT-ISTANBUL


"OssieMac":

Just a bit more info on your code. I modified it yesterday so that I had the
worksheet names in one column and the sheet names in another column. That way
I am able to use autofilter to see the sheets related to a particular
workbook. Using this method might make it easier to set up a combo box so
that you can relate a sheet to the workbook (It repeats the workbook name for
each worksheet) so here is the modified code. You will also see that I have
now used CurDir instead of Default so that I can run it from any folder and
it will work for the folder it is in and any subfolders. I also had a problem
with it wanting to re-open the workbook from which I was running the macro I
had to handle that also.

Dim i As Integer 'Used in loop.
Dim j As Integer 'Used for row identifier when writing data.
Dim wbResults As Workbook 'Name of workbook found
Dim wbCodeBook As Workbook 'Holds name of this workbook
Dim currentFile As String 'Id of current file with full path
Dim wSheet As Worksheet 'Worksheet in found workbook
Dim myCurrentPath As String 'Current path of this workbook
Dim myCurrentPathLgth As Integer 'Length of path string used in Mid()
function

Sub GetAllWorksheetNames()

'This macro designed to run from the folder where it has to _
search for the files and subfolders.

Sheets("Sheet1").Select

Cells.Select
Selection.Clear

'Insert column titles
Range("A1") = "Work Book Name"
Range("B1") = "Work Sheet Name"
Range("A1:B1").Font.Bold = True
Range("A1").Select

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

myCurrentPath = CurDir
currentFile = myCurrentPath & "\" & ActiveWorkbook.Name

'Plus 2 allows backslash plus 1 for next
'start character in the mid()function below
myCurrentPathLgth = Len(myCurrentPath) + 2

Set wbCodeBook = ThisWorkbook

With Application.FileSearch
.NewSearch
.LookIn = myCurrentPath
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute 0 Then ' 0 Then files of required type exist
j = 1 'Row numbers. Initialize as 1 to allow for column headers
For i = 1 To .FoundFiles.Count
'Test that not current file in use.
If LCase(.FoundFiles(i)) < LCase(currentFile) Then
Set wbResults = Workbooks.Open(.FoundFiles(i))
For Each wSheet In wbResults.Worksheets
j = j + 1 'Sets row number
wbCodeBook.Sheets(1).Cells(j, 1) _
= Mid(.FoundFiles(i), myCurrentPathLgth)
wbCodeBook.Sheets(1).Cells(j, 2) = Format(wSheet.Name)
Next wSheet
wbResults.Close SaveChanges:=False
End If
Next i
End If
End With

Sheets("Sheet1").Select
Columns("A:B").Select
Selection.Columns.AutoFit
Range("A1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.CalculateFull

End Sub

hi,

list will be written in the workbook that is in my computer, but workbooks
which will be searched will be in the server.can we make them as links ? if
they are not as link,I will have to find the place of file from the search.

--
SAHRAYICEDIT-ISTANBUL


"OssieMac":

Just a bit more info on your code. I modified it yesterday so that I had the
worksheet names in one column and the sheet names in another column. That way
I am able to use autofilter to see the sheets related to a particular
workbook. Using this method might make it easier to set up a combo box so
that you can relate a sheet to the workbook (It repeats the workbook name for
each worksheet) so here is the modified code. You will also see that I have
now used CurDir instead of Default so that I can run it from any folder and
it will work for the folder it is in and any subfolders. I also had a problem
with it wanting to re-open the workbook from which I was running the macro I
had to handle that also.

Dim i As Integer 'Used in loop.
Dim j As Integer 'Used for row identifier when writing data.
Dim wbResults As Workbook 'Name of workbook found
Dim wbCodeBook As Workbook 'Holds name of this workbook
Dim currentFile As String 'Id of current file with full path
Dim wSheet As Worksheet 'Worksheet in found workbook
Dim myCurrentPath As String 'Current path of this workbook
Dim myCurrentPathLgth As Integer 'Length of path string used in Mid()
function

Sub GetAllWorksheetNames()

'This macro designed to run from the folder where it has to _
search for the files and subfolders.

Sheets("Sheet1").Select

Cells.Select
Selection.Clear

'Insert column titles
Range("A1") = "Work Book Name"
Range("B1") = "Work Sheet Name"
Range("A1:B1").Font.Bold = True
Range("A1").Select

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

myCurrentPath = CurDir
currentFile = myCurrentPath & "\" & ActiveWorkbook.Name

'Plus 2 allows backslash plus 1 for next
'start character in the mid()function below
myCurrentPathLgth = Len(myCurrentPath) + 2

Set wbCodeBook = ThisWorkbook

With Application.FileSearch
.NewSearch
.LookIn = myCurrentPath
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute 0 Then ' 0 Then files of required type exist
j = 1 'Row numbers. Initialize as 1 to allow for column headers
For i = 1 To .FoundFiles.Count
'Test that not current file in use.
If LCase(.FoundFiles(i)) < LCase(currentFile) Then
Set wbResults = Workbooks.Open(.FoundFiles(i))
For Each wSheet In wbResults.Worksheets
j = j + 1 'Sets row number
wbCodeBook.Sheets(1).Cells(j, 1) _
= Mid(.FoundFiles(i), myCurrentPathLgth)
wbCodeBook.Sheets(1).Cells(j, 2) = Format(wSheet.Name)
Next wSheet
wbResults.Close SaveChanges:=False
End If
Next i
End If
End With

Sheets("Sheet1").Select
Columns("A:B").Select
Selection.Columns.AutoFit
Range("A1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.CalculateFull

End Sub

Hi SAHRAYICEDIT-ISTANBUL -

Below is a modified version of what I posted in yesterday's thread. It's an
amalgam of your original work, OssieMac's improvements, and my input. Use
this version as you see fit or extract the single statement from the code
that contains the word "Hyperlink" and insert it in your version where
appropriate.

This version permits browsing to the parent folder at run time, but only if
there is at least one file in that folder. When prompted, select any file in
a folder and choose Open.

Let us know how it works in your networked environment.
---------------------------------------------------------------------------------------------
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
ActiveWindow.FreezePanes = False

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

pFolder = Application.GetOpenFilename
If pFolder < "False" Then
pFolder = Left(pFolder, InStrRev(pFolder, "\") - 1)
Else
MsgBox "Procedure canceled. No file selected."
Exit Sub
End If

With Application.filesearch
..NewSearch
..LookIn = pFolder
..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
Set wbResults = ThisWorkbook
Else
Set wbResults = Workbooks.Open(.FoundFiles(i))
End If

'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 filenames
wbCodeBookws.Range(wbCodeBookws.Cells(tRow, 3), _
wbCodeBookws.Cells(bRow, 3)) = Mid(.FoundFiles(i), L + 1)

'Lay in full workbook pathname as a hyperlink
For ih = tRow To bRow
ActiveSheet.Hyperlinks.Add _
Anchor:=wbCodeBookws.Cells(ih, 4), _
Address:=.FoundFiles(i)
Next ih

If wbResults.FullName < ThisWorkbook.FullName Then _
wbResults.Close SaveChanges:=False
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

'Format Output
wbCodeBookws.Activate
wbCodeBookws.Cells(2, 1).Select
ActiveWindow.FreezePanes = True
wbCodeBookws.Columns("A:D").AutoFit
Selection.AutoFilter

wrapSub:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Exit Sub

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

End Sub
--
Jay


"excel-tr" wrote:

hi,

list will be written in the workbook that is in my computer, but workbooks
which will be searched will be in the server.can we make them as links ? if
they are not as link,I will have to find the place of file from the search.

--
SAHRAYICEDIT-ISTANBUL


"OssieMac":

Just a bit more info on your code. I modified it yesterday so that I had the
worksheet names in one column and the sheet names in another column. That way
I am able to use autofilter to see the sheets related to a particular
workbook. Using this method might make it easier to set up a combo box so
that you can relate a sheet to the workbook (It repeats the workbook name for
each worksheet) so here is the modified code. You will also see that I have
now used CurDir instead of Default so that I can run it from any folder and
it will work for the folder it is in and any subfolders. I also had a problem
with it wanting to re-open the workbook from which I was running the macro I
had to handle that also.

Dim i As Integer 'Used in loop.
Dim j As Integer 'Used for row identifier when writing data.
Dim wbResults As Workbook 'Name of workbook found
Dim wbCodeBook As Workbook 'Holds name of this workbook
Dim currentFile As String 'Id of current file with full path
Dim wSheet As Worksheet 'Worksheet in found workbook
Dim myCurrentPath As String 'Current path of this workbook
Dim myCurrentPathLgth As Integer 'Length of path string used in Mid()
function

Sub GetAllWorksheetNames()

'This macro designed to run from the folder where it has to _
search for the files and subfolders.

Sheets("Sheet1").Select

Cells.Select
Selection.Clear

'Insert column titles
Range("A1") = "Work Book Name"
Range("B1") = "Work Sheet Name"
Range("A1:B1").Font.Bold = True
Range("A1").Select

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

myCurrentPath = CurDir
currentFile = myCurrentPath & "\" & ActiveWorkbook.Name

'Plus 2 allows backslash plus 1 for next
'start character in the mid()function below
myCurrentPathLgth = Len(myCurrentPath) + 2

Set wbCodeBook = ThisWorkbook

With Application.FileSearch
.NewSearch
.LookIn = myCurrentPath
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute 0 Then ' 0 Then files of required type exist
j = 1 'Row numbers. Initialize as 1 to allow for column headers
For i = 1 To .FoundFiles.Count
'Test that not current file in use.
If LCase(.FoundFiles(i)) < LCase(currentFile) Then
Set wbResults = Workbooks.Open(.FoundFiles(i))
For Each wSheet In wbResults.Worksheets
j = j + 1 'Sets row number
wbCodeBook.Sheets(1).Cells(j, 1) _
= Mid(.FoundFiles(i), myCurrentPathLgth)
wbCodeBook.Sheets(1).Cells(j, 2) = Format(wSheet.Name)
Next wSheet
wbResults.Close SaveChanges:=False
End If
Next i
End If
End With

Sheets("Sheet1").Select
Columns("A:B").Select
Selection.Columns.AutoFit
Range("A1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.CalculateFull

End Sub

Hi SAHRAYICEDIT-ISTANBUL

I'll wait on your reply to Jay before doing anymore on this but I am quite
happy to continue on it if you want me to. In the mean time, what version of
Excel are you using because it could make a difference as to how to approach
the problem?

Regards,

OssieMac

"Jay" wrote:

Hi SAHRAYICEDIT-ISTANBUL -

Below is a modified version of what I posted in yesterday's thread. It's an
amalgam of your original work, OssieMac's improvements, and my input. Use
this version as you see fit or extract the single statement from the code
that contains the word "Hyperlink" and insert it in your version where
appropriate.

This version permits browsing to the parent folder at run time, but only if
there is at least one file in that folder. When prompted, select any file in
a folder and choose Open.

Let us know how it works in your networked environment.
---------------------------------------------------------------------------------------------
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
ActiveWindow.FreezePanes = False

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

pFolder = Application.GetOpenFilename
If pFolder < "False" Then
pFolder = Left(pFolder, InStrRev(pFolder, "\") - 1)
Else
MsgBox "Procedure canceled. No file selected."
Exit Sub
End If

With Application.filesearch
.NewSearch
.LookIn = pFolder
.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
Set wbResults = ThisWorkbook
Else
Set wbResults = Workbooks.Open(.FoundFiles(i))
End If

'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 filenames
wbCodeBookws.Range(wbCodeBookws.Cells(tRow, 3), _
wbCodeBookws.Cells(bRow, 3)) = Mid(.FoundFiles(i), L + 1)

'Lay in full workbook pathname as a hyperlink
For ih = tRow To bRow
ActiveSheet.Hyperlinks.Add _
Anchor:=wbCodeBookws.Cells(ih, 4), _
Address:=.FoundFiles(i)
Next ih

If wbResults.FullName < ThisWorkbook.FullName Then _
wbResults.Close SaveChanges:=False
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

'Format Output
wbCodeBookws.Activate
wbCodeBookws.Cells(2, 1).Select
ActiveWindow.FreezePanes = True
wbCodeBookws.Columns("A:D").AutoFit
Selection.AutoFilter

wrapSub:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Exit Sub

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

End Sub
--
Jay


"excel-tr" wrote:

hi,

list will be written in the workbook that is in my computer, but workbooks
which will be searched will be in the server.can we make them as links ? if
they are not as link,I will have to find the place of file from the search.

--
SAHRAYICEDIT-ISTANBUL


"OssieMac":

Just a bit more info on your code. I modified it yesterday so that I had the
worksheet names in one column and the sheet names in another column. That way
I am able to use autofilter to see the sheets related to a particular
workbook. Using this method might make it easier to set up a combo box so
that you can relate a sheet to the workbook (It repeats the workbook name for
each worksheet) so here is the modified code. You will also see that I have
now used CurDir instead of Default so that I can run it from any folder and
it will work for the folder it is in and any subfolders. I also had a problem
with it wanting to re-open the workbook from which I was running the macro I
had to handle that also.

Dim i As Integer 'Used in loop.
Dim j As Integer 'Used for row identifier when writing data.
Dim wbResults As Workbook 'Name of workbook found
Dim wbCodeBook As Workbook 'Holds name of this workbook
Dim currentFile As String 'Id of current file with full path
Dim wSheet As Worksheet 'Worksheet in found workbook
Dim myCurrentPath As String 'Current path of this workbook
Dim myCurrentPathLgth As Integer 'Length of path string used in Mid()
function

Sub GetAllWorksheetNames()

'This macro designed to run from the folder where it has to _
search for the files and subfolders.

Sheets("Sheet1").Select

Cells.Select
Selection.Clear

'Insert column titles
Range("A1") = "Work Book Name"
Range("B1") = "Work Sheet Name"
Range("A1:B1").Font.Bold = True
Range("A1").Select

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

myCurrentPath = CurDir
currentFile = myCurrentPath & "\" & ActiveWorkbook.Name

'Plus 2 allows backslash plus 1 for next
'start character in the mid()function below
myCurrentPathLgth = Len(myCurrentPath) + 2

Set wbCodeBook = ThisWorkbook

With Application.FileSearch
.NewSearch
.LookIn = myCurrentPath
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute 0 Then ' 0 Then files of required type exist
j = 1 'Row numbers. Initialize as 1 to allow for column headers
For i = 1 To .FoundFiles.Count
'Test that not current file in use.
If LCase(.FoundFiles(i)) < LCase(currentFile) Then
Set wbResults = Workbooks.Open(.FoundFiles(i))
For Each wSheet In wbResults.Worksheets
j = j + 1 'Sets row number
wbCodeBook.Sheets(1).Cells(j, 1) _
= Mid(.FoundFiles(i), myCurrentPathLgth)
wbCodeBook.Sheets(1).Cells(j, 2) = Format(wSheet.Name)
Next wSheet
wbResults.Close SaveChanges:=False
End If
Next i
End If
End With

Sheets("Sheet1").Select
Columns("A:B").Select
Selection.Columns.AutoFit
Range("A1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.CalculateFull

End Sub