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

Hi,

below code is useful, but I do not want to choose any file for code to
start.Workbooks will be in 5 different folders.5 different folder will be in
one folder.code will automatically search the adress that I gave in the code.

for example adress will be d:\new folder ( new folder has 5 sub folders )

regards.
--
SAHRAYICEDIT-ISTANBUL


"OssieMac":

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

Hi OssieMac -

It looks like S-I prefers your latest version, so I'll back off unless
needed - don't want excess versions clogging up the process.

Here's the hyperlink statement I used in my last version to successfully add
the hyperlink feature that S-I is interested in:

ActiveSheet.Hyperlinks.Add _
Anchor:=wbCodeBookws.Cells(ih, 4), _
Address:=.FoundFiles(i)

You'll have to dress it up with a row index that's compatible with your
version and find a home for it, but it was the very last modification I added
in my code and surprisingly, it didn't impact other code at all... In other
words, I don't think your code will need much (if any) modifications if you
can find a home for this statement.

Good luck and I'll keep an eye on this thread to see if there is anything I
can contribute.
--
Jay


"OssieMac" wrote:

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

Hi SAHRAYICEDIT-ISTANBUL and Jay,

First of all acknowledgement to Jay. All contributions are greatfully
received by me because they all add to one's library of knowledge of how to
tackle a problem. However, as you suggested, I am happy to continue from here
and get back to you if I have a problem.

To SAHRAYICEDIT-ISTANBUL,

Further to Jays comments, we have reached the stage where it is now
essential to go to the basics of programming and document exactly what you
are trying to achieve otherwise we are flying blind and creating routines
that do not perform to your requirements. Ill list the criteria as I
understand it and then add some questions for you to answer so that I can
fully understand what it is you are trying to achieve and work towards that.

1. I understand that the procedure will be run from a workbook located in a
folder on your PC and the folders to be searched are on a network and in
entirely different folders. (If this is correct then there is no need to
check whether the procedure is attempting to re-open the workbook with the
macro.)

2. The latest example you posted places the worksheets in the first column
and the Workbook names in column 7. Is this essential to your requirements or
can the workbook names and worksheet names be placed in adjacent columns?

3. To successfully set up links, the full file path needs to be saved
somewhere. Do you want to be able to view this path or do you just want to be
able to view the workbook names and the worksheet names with the full file
path saved but hidden? I understand that the search starts from a specific
path on the network and searches several folders from that path. If required,
it is possible to just save and hide the main initial search path somewhere
and then include any folder names past that point with the workbook names so
let me know what you want.

4. Can the sheet where the workbook and worksheet names are saved be cleared
of data prior to running the procedure or do you anticipate running it for a
specific file path and then change the file path and run it again at another
file path and append to previous data. This makes a difference as to the best
way to handle recording the data on the worksheet.

5. Do you want column headers in the first row of the data? (eg. Workbook
Name and Worksheet Name).

6. When the links are created to the worksheets, what do you intend doing
after clicking on the link and opening the workbook at the required
worksheet? What I mean by this is will you be simply doing work manually
within the worksheet and then saving and closing it or do you anticipate
having additional automated processing like copying data from the newly
opened workbook to another workbook? Your answer to this makes a difference
as to how to handle the code for this process.

7. Are the workbooks on the network likely to be in use by another user when
you want to access them? That is are they shared workbooks?

8. As per my question in a previous posing, what version of Excel are you
using?

Regards,

OssieMac

Hi,

you can find my answers below.nearly everyday a workbook is added to the
folders or a worksheet is added to a workbook in the shared path in the
company.
--
SAHRAYICEDIT-ISTANBUL


"OssieMac":

Hi SAHRAYICEDIT-ISTANBUL and Jay,

First of all acknowledgement to Jay. All contributions are greatfully
received by me because they all add to one's library of knowledge of how to
tackle a problem. However, as you suggested, I am happy to continue from here
and get back to you if I have a problem.

To SAHRAYICEDIT-ISTANBUL,

Further to Jays comments, we have reached the stage where it is now
essential to go to the basics of programming and document exactly what you
are trying to achieve otherwise we are flying blind and creating routines
that do not perform to your requirements. Ill list the criteria as I
understand it and then add some questions for you to answer so that I can
fully understand what it is you are trying to achieve and work towards that.

1. I understand that the procedure will be run from a workbook located in a
folder on your PC and the folders to be searched are on a network and in
entirely different folders. (If this is correct then there is no need to
check whether the procedure is attempting to re-open the workbook with the
macro.)
***yes,you are right.folders are shared for all users.anyone can reach the
folders in the company.list will be written an a excel file in my computer.

2. The latest example you posted places the worksheets in the first column
and the Workbook names in column 7. Is this essential to your requirements or
can the workbook names and worksheet names be placed in adjacent columns?
***I only want to see worksheetnames, but I must be capable of clicking the
name to open the excel file to see the worksheet.

3. To successfully set up links, the full file path needs to be saved
somewhere. Do you want to be able to view this path or do you just want to be
able to view the workbook names and the worksheet names with the full file
path saved but hidden? I understand that the search starts from a specific
path on the network and searches several folders from that path. If required,
it is possible to just save and hide the main initial search path somewhere
and then include any folder names past that point with the workbook names so
let me know what you want.
*** I do not need to see the path, when the mouse is on the worksheetname, it is enough to see the path,if it is impossible no problem.when I click the name, the workbook will be opened, I will see the name of the workbook, I can find it from the search.
4. Can the sheet where the workbook and worksheet names are saved be cleared
of data prior to running the procedure or do you anticipate running it for a
specific file path and then change the file path and run it again at another
file path and append to previous data. This makes a difference as to the best
way to handle recording the data on the worksheet.
***no, path that will be searched is constant for example D:\costs

5. Do you want column headers in the first row of the data? (eg. Workbook
Name and Worksheet Name).
***ı do not need to see any of them

6. When the links are created to the worksheets, what do you intend doing
after clicking on the link and opening the workbook at the required
worksheet? What I mean by this is will you be simply doing work manually
within the worksheet and then saving and closing it or do you anticipate
having additional automated processing like copying data from the newly
opened workbook to another workbook? Your answer to this makes a difference
as to how to handle the code for this process.
***when I click the worksheetname, the workbook will be opened then I will
print then close the file.

7. Are the workbooks on the network likely to be in use by another user when
you want to access them? That is are they shared workbooks?
***all of the workbooks are shared

8. As per my question in a previous posing, what version of Excel are you
using?
*** ı am using excel 2003 at home and company.but when I run the below code
at home I have no problem, when I try it in the company "sub or function not
defined" error comes.one more problem with this code is that is does not get
all worksheetnames from all workbooks and after running nearly one minute it
gives
"An error occurred... action canceled."

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

Regards,

OssieMac

I'm back again SAHRAYICEDIT. See how this example of code runs for you.

I have identified two problems. One I can't fix and that is that the
procedure is very memory hungry. Each time it closes a workbook it does not
appear to release all of the memory used to open it. That might give you
problems and could be the reason why some code examples run on your PC at
home but not on the network where there are probably many more workbooks to
open.

The other problem is that it finds files which have been deleted and of
course it can't open them. This is handled by the On Error Resume Next and I
had to get rid of my previous method of selecting the rows for the data and
revert to the original method.

Anyway give this one a try and let me know how it goes.

I have saved the main search path at cell AA1. The path after that main
search path is saved with the workbook name because it must be saved
somewhere and the workbook name is repeated for each worksheet. The sheet
names are in the second column and hyperlinks in the third column.

The explanations are in comments in the code. Read them carefully
particularly in relation to the hyperlink code where the section inside the
quotes must be on one line.

Dim i As Integer 'Used in loop.
Dim wbResults As Workbook 'Name of workbook found
Dim wbCodeBook As Workbook 'Name of this workbook
Dim wSheet As Worksheet 'WorkSheet in found WorkBook
Dim mySearchPath As String 'Search Path
Dim mySearchPathLgth As Integer 'Length of path string used in Mid() function

Sub GetAllWorksheetNames()

On Error Resume Next

'Change the mySearchPath line to match the path
'where you want to search.
'Ensure the quotes (inverted commas) remain at each end.

mySearchPath = "D:\costs"

Sheets(1).Select

'Clear the sheet of all existing data
Cells.Select
Selection.Clear

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

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

'Length of search path + 1 used to find next
'character in the mid()function used to find
'the worksheet name from the full path.
mySearchPathLgth = Len(mySearchPath) + 2

'Save Search Path for use in Hyperlinks.
'Can be saved anywhere but change the R1C27 in the
'Hyperlink code to match the row and column where saved.
'NOTE: R1C27 is Row 1 column 27 (same as cell AA1 but use
'R1C27 format in the hyperlink formula.
Sheets(1).Range("AA1") = mySearchPath & "\"

Set wbCodeBook = ThisWorkbook

With Application.FileSearch
.NewSearch
.LookIn = mySearchPath
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute 0 Then ' 0 Then files of required type exist

For i = 1 To .FoundFiles.Count
Set wbResults = Workbooks.Open(.FoundFiles(i))
For Each wSheet In wbResults.Worksheets

'Write WorkBook Name to column 1
wbCodeBook.Sheets(1).Cells(Rows.Count, 1).End(xlUp)(2,
1) _
= Mid(.FoundFiles(i), mySearchPathLgth)

'Write the WorkSheet Name to column 2
wbCodeBook.Sheets(1).Cells(Rows.Count, 1).End(xlUp)(1,
2) _
= wSheet.Name

'Write Hyperlink to column 3
'Hyperlink code. If cell address where the path
'is saved has been changed then the first
'address (R1C27)must be changed to match.

'NOTE: the section of this code with the inverted commas
'(quotes) must be on one line. You cannot break this
'section of code with an underscore.
wbCodeBook.Sheets(1).Cells(Rows.Count, 1).End(xlUp)(1,
3) _
.FormulaR1C1 = _
"=HYPERLINK(""[""&R1C27&RC[-2]&""]""&RC[-1]&""!A1"",""Open Sheet ""
&RC[-1])"

Next wSheet
'Close the found workbook
wbResults.Close SaveChanges:=False
Next i
End If
End With

On Error GoTo 0

'Auto size columns for the data
Sheets(1).Select
Columns("A:C").Select
Selection.Columns.AutoFit

'Finalize
Range("A1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub

Regards,

OssieMac

hi,

syntax error n this code, can u help ?

wbCodeBook.Sheets(1).Cells(Rows.Count, 1).End(xlUp)(1, 3).FormulaR1C1 =
"=HYPERLINK(""[""&R1C27&RC[-2]&""]""&RC[-1]&""!A1"",""Open Sheet """&RC[-1])"
--
SAHRAYICEDIT-ISTANBUL


"OssieMac":

I'm back again SAHRAYICEDIT. See how this example of code runs for you.

I have identified two problems. One I can't fix and that is that the
procedure is very memory hungry. Each time it closes a workbook it does not
appear to release all of the memory used to open it. That might give you
problems and could be the reason why some code examples run on your PC at
home but not on the network where there are probably many more workbooks to
open.

The other problem is that it finds files which have been deleted and of
course it can't open them. This is handled by the On Error Resume Next and I
had to get rid of my previous method of selecting the rows for the data and
revert to the original method.

Anyway give this one a try and let me know how it goes.

I have saved the main search path at cell AA1. The path after that main
search path is saved with the workbook name because it must be saved
somewhere and the workbook name is repeated for each worksheet. The sheet
names are in the second column and hyperlinks in the third column.

The explanations are in comments in the code. Read them carefully
particularly in relation to the hyperlink code where the section inside the
quotes must be on one line.

Dim i As Integer 'Used in loop.
Dim wbResults As Workbook 'Name of workbook found
Dim wbCodeBook As Workbook 'Name of this workbook
Dim wSheet As Worksheet 'WorkSheet in found WorkBook
Dim mySearchPath As String 'Search Path
Dim mySearchPathLgth As Integer 'Length of path string used in Mid() function

Sub GetAllWorksheetNames()

On Error Resume Next

'Change the mySearchPath line to match the path
'where you want to search.
'Ensure the quotes (inverted commas) remain at each end.

mySearchPath = "D:\costs"

Sheets(1).Select

'Clear the sheet of all existing data
Cells.Select
Selection.Clear

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

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

'Length of search path + 1 used to find next
'character in the mid()function used to find
'the worksheet name from the full path.
mySearchPathLgth = Len(mySearchPath) + 2

'Save Search Path for use in Hyperlinks.
'Can be saved anywhere but change the R1C27 in the
'Hyperlink code to match the row and column where saved.
'NOTE: R1C27 is Row 1 column 27 (same as cell AA1 but use
'R1C27 format in the hyperlink formula.
Sheets(1).Range("AA1") = mySearchPath & "\"

Set wbCodeBook = ThisWorkbook

With Application.FileSearch
.NewSearch
.LookIn = mySearchPath
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute 0 Then ' 0 Then files of required type exist

For i = 1 To .FoundFiles.Count
Set wbResults = Workbooks.Open(.FoundFiles(i))
For Each wSheet In wbResults.Worksheets

'Write WorkBook Name to column 1
wbCodeBook.Sheets(1).Cells(Rows.Count, 1).End(xlUp)(2,
1) _
= Mid(.FoundFiles(i), mySearchPathLgth)

'Write the WorkSheet Name to column 2
wbCodeBook.Sheets(1).Cells(Rows.Count, 1).End(xlUp)(1,
2) _
= wSheet.Name

'Write Hyperlink to column 3
'Hyperlink code. If cell address where the path
'is saved has been changed then the first
'address (R1C27)must be changed to match.

'NOTE: the section of this code with the inverted commas
'(quotes) must be on one line. You cannot break this
'section of code with an underscore.
wbCodeBook.Sheets(1).Cells(Rows.Count, 1).End(xlUp)(1,
3) _
.FormulaR1C1 = _
"=HYPERLINK(""[""&R1C27&RC[-2]&""]""&RC[-1]&""!A1"",""Open Sheet ""
&RC[-1])"

Next wSheet
'Close the found workbook
wbResults.Close SaveChanges:=False
Next i
End If
End With

On Error GoTo 0

'Auto size columns for the data
Sheets(1).Select
Columns("A:C").Select
Selection.Columns.AutoFit

'Finalize
Range("A1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub

Regards,

OssieMac

Hi S-I:

OssieMac's original worked fine for me. It is posted below. The statement
you posted was missing the underscore continuation character at the end of
the first line and had an extra double-quote to the right of the Open Sheet
string.

Try this from the original:
wbCodeBook.Sheets(1).Cells(Rows.Count, 1).End(xlUp)(1, 3).FormulaR1C1 = _
"=HYPERLINK(""[""&R1C27&RC[-2]&""]""&RC[-1]&""!A1"",""Open Sheet ""&RC[-1])"

--
Jay


"excel-tr" wrote:

hi,

syntax error n this code, can u help ?

wbCodeBook.Sheets(1).Cells(Rows.Count, 1).End(xlUp)(1, 3).FormulaR1C1 =
"=HYPERLINK(""[""&R1C27&RC[-2]&""]""&RC[-1]&""!A1"",""Open Sheet """&RC[-1])"
--
SAHRAYICEDIT-ISTANBUL


"OssieMac":

I'm back again SAHRAYICEDIT. See how this example of code runs for you.

I have identified two problems. One I can't fix and that is that the
procedure is very memory hungry. Each time it closes a workbook it does not
appear to release all of the memory used to open it. That might give you
problems and could be the reason why some code examples run on your PC at
home but not on the network where there are probably many more workbooks to
open.

The other problem is that it finds files which have been deleted and of
course it can't open them. This is handled by the On Error Resume Next and I
had to get rid of my previous method of selecting the rows for the data and
revert to the original method.

Anyway give this one a try and let me know how it goes.

I have saved the main search path at cell AA1. The path after that main
search path is saved with the workbook name because it must be saved
somewhere and the workbook name is repeated for each worksheet. The sheet
names are in the second column and hyperlinks in the third column.

The explanations are in comments in the code. Read them carefully
particularly in relation to the hyperlink code where the section inside the
quotes must be on one line.

Dim i As Integer 'Used in loop.
Dim wbResults As Workbook 'Name of workbook found
Dim wbCodeBook As Workbook 'Name of this workbook
Dim wSheet As Worksheet 'WorkSheet in found WorkBook
Dim mySearchPath As String 'Search Path
Dim mySearchPathLgth As Integer 'Length of path string used in Mid() function

Sub GetAllWorksheetNames()

On Error Resume Next

'Change the mySearchPath line to match the path
'where you want to search.
'Ensure the quotes (inverted commas) remain at each end.

mySearchPath = "D:\costs"

Sheets(1).Select

'Clear the sheet of all existing data
Cells.Select
Selection.Clear

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

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

'Length of search path + 1 used to find next
'character in the mid()function used to find
'the worksheet name from the full path.
mySearchPathLgth = Len(mySearchPath) + 2

'Save Search Path for use in Hyperlinks.
'Can be saved anywhere but change the R1C27 in the
'Hyperlink code to match the row and column where saved.
'NOTE: R1C27 is Row 1 column 27 (same as cell AA1 but use
'R1C27 format in the hyperlink formula.
Sheets(1).Range("AA1") = mySearchPath & "\"

Set wbCodeBook = ThisWorkbook

With Application.FileSearch
.NewSearch
.LookIn = mySearchPath
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute 0 Then ' 0 Then files of required type exist

For i = 1 To .FoundFiles.Count
Set wbResults = Workbooks.Open(.FoundFiles(i))
For Each wSheet In wbResults.Worksheets

'Write WorkBook Name to column 1
wbCodeBook.Sheets(1).Cells(Rows.Count, 1).End(xlUp)(2,
1) _
= Mid(.FoundFiles(i), mySearchPathLgth)

'Write the WorkSheet Name to column 2
wbCodeBook.Sheets(1).Cells(Rows.Count, 1).End(xlUp)(1,
2) _
= wSheet.Name

'Write Hyperlink to column 3
'Hyperlink code. If cell address where the path
'is saved has been changed then the first
'address (R1C27)must be changed to match.

'NOTE: the section of this code with the inverted commas
'(quotes) must be on one line. You cannot break this
'section of code with an underscore.
wbCodeBook.Sheets(1).Cells(Rows.Count, 1).End(xlUp)(1,
3) _
.FormulaR1C1 = _
"=HYPERLINK(""[""&R1C27&RC[-2]&""]""&RC[-1]&""!A1"",""Open Sheet ""
&RC[-1])"

Next wSheet
'Close the found workbook
wbResults.Close SaveChanges:=False
Next i
End If
End With

On Error GoTo 0

'Auto size columns for the data
Sheets(1).Select
Columns("A:C").Select
Selection.Columns.AutoFit

'Finalize
Range("A1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub

Regards,

OssieMac

Hi OssieMac -

Looks like you're making good progress. Just a thought on the memory
problem. This may be a long-shot, and maybe you've already tried this, but
maybe try adding:

set wbResults = Nothing

after:

wbResults.Close SaveChanges:=False

Because Set generally creates object references and not objects, this may
not cure the problem. Also, I believe that each time the Set wbResults is
executed, the space reserved for the wbResults variable is reused, but a test
would be simple and it would help rule out the wbResults variable space as
the cause of the problem.

Just a thought,
Jay

Hi,

it works well at home but not in the company. maybe beacuse of cpu and ram
capacity.I will try below code. You really like to help, thanks for your
interest.What is your job ?
--
SAHRAYICEDIT-ISTANBUL


"Jay":

Hi OssieMac -

Looks like you're making good progress. Just a thought on the memory
problem. This may be a long-shot, and maybe you've already tried this, but
maybe try adding:

set wbResults = Nothing

after:

wbResults.Close SaveChanges:=False

Because Set generally creates object references and not objects, this may
not cure the problem. Also, I believe that each time the Set wbResults is
executed, the space reserved for the wbResults variable is reused, but a test
would be simple and it would help rule out the wbResults variable space as
the cause of the problem.

Just a thought,
Jay

Hi. I'm back again with a couple of tests you might like to try.

Firstly try commenting out the following line:-
'Application.ScreenUpdating = False
(Simply put a single quote at start of line like above and it should turn
green.)
The list will then be updated as each worksheet is opened and should give us
an idea if the macro actually starts running on the network. Looks horrible
with the screen flashing up with the worksheets etc but I would like to know
how many sheets get displayed before it fails. (Just the row number will be
sufficient.)

If the macro runs and displays at least some of sheets, the next test is to
reset the path so that it only picks up a smaller number of workbooks.
Example:- If you have it set to D:\costs then try something like this
D:\costs\another folder.

Let me know how you go with it. And to answer your question, I am a retired
Business Analyst and have been using PC's and spreadsheets since the early
1980's and have used Excel since it first come on the market. Currently I do
a bit of consulting when I am not filling in my time on this forum.

To Jay. Tried your suggestion. Makes no difference.

Regards,

OssieMac

"excel-tr" wrote:

Hi,

it works well at home but not in the company. maybe beacuse of cpu and ram
capacity.I will try below code. You really like to help, thanks for your
interest.What is your job ?
--
SAHRAYICEDIT-ISTANBUL


"Jay":

Hi OssieMac -

Looks like you're making good progress. Just a thought on the memory
problem. This may be a long-shot, and maybe you've already tried this, but
maybe try adding:

set wbResults = Nothing

after:

wbResults.Close SaveChanges:=False

Because Set generally creates object references and not objects, this may
not cure the problem. Also, I believe that each time the Set wbResults is
executed, the space reserved for the wbResults variable is reused, but a test
would be simple and it would help rule out the wbResults variable space as
the cause of the problem.

Just a thought,
Jay

hi,

I tried both of them, but freezes some time later, I cannot see number of
lines. Can we save the number of lines into a *.txt file to see after when I
stop it running
--
SAHRAYICEDIT-ISTANBUL


"OssieMac":

Hi. I'm back again with a couple of tests you might like to try.

Firstly try commenting out the following line:-
'Application.ScreenUpdating = False
(Simply put a single quote at start of line like above and it should turn
green.)
The list will then be updated as each worksheet is opened and should give us
an idea if the macro actually starts running on the network. Looks horrible
with the screen flashing up with the worksheets etc but I would like to know
how many sheets get displayed before it fails. (Just the row number will be
sufficient.)

If the macro runs and displays at least some of sheets, the next test is to
reset the path so that it only picks up a smaller number of workbooks.
Example:- If you have it set to D:\costs then try something like this
D:\costs\another folder.

Let me know how you go with it. And to answer your question, I am a retired
Business Analyst and have been using PC's and spreadsheets since the early
1980's and have used Excel since it first come on the market. Currently I do
a bit of consulting when I am not filling in my time on this forum.

To Jay. Tried your suggestion. Makes no difference.

Regards,

OssieMac

"excel-tr" wrote:

Hi,

it works well at home but not in the company. maybe beacuse of cpu and ram
capacity.I will try below code. You really like to help, thanks for your
interest.What is your job ?
--
SAHRAYICEDIT-ISTANBUL


"Jay":

Hi OssieMac -

Looks like you're making good progress. Just a thought on the memory
problem. This may be a long-shot, and maybe you've already tried this, but
maybe try adding:

set wbResults = Nothing

after:

wbResults.Close SaveChanges:=False

Because Set generally creates object references and not objects, this may
not cure the problem. Also, I believe that each time the Set wbResults is
executed, the space reserved for the wbResults variable is reused, but a test
would be simple and it would help rule out the wbResults variable space as
the cause of the problem.

Just a thought,
Jay

Hi again,

One more test and then I am out of ideas. The path on the network is a
mapped path and I wonder if Excel sees it that way or whether it sees the
fully qualified path because it does do some funny things sometimes.

Copy the small macro below into a new workbook.

Change back from the VBA editor to Sheet1.

Go into File Open as if you are going to open a file and change into the
network folder (D:\costs or whatever folder you use) but do not open any
files. Close the fileopen window.

Run the Test_File_Path macro and then check the filepath in cell A1 on
Sheet1 and see whether it is the same as you have been using as the filepath.
If it is different, then try it as your filepath in the code.

Sub Test_File_Path()
Sheets("Sheet1").Range("A1") = CurDir
End Sub

If this does not work, then I suggest that you start a new thread on this
forum and post the code on it and describe what happens. Include the
information that it runs on your home computer but not on the network and
request that the MVP's look at it and see if they can tell you what is wrong.

Your suggestion is worth a thought but if it won't write to the spreadsheet
then I doubt that it will write to a txt file either.

Regards,

OssieMac

Hi,

I understood what u mean. ı do not think there is a problem with the adress.
everytime I run I can see a different situation. for example it worked well
some time and added the adresses correctly but later it stopped.I think there
is a problem with the memory or something else. I will copy the path to my
home pc and try it at home, then send my question to the group.what is mvp ?
thanks again
--
SAHRAYICEDIT-ISTANBUL


"OssieMac":

Hi again,

One more test and then I am out of ideas. The path on the network is a
mapped path and I wonder if Excel sees it that way or whether it sees the
fully qualified path because it does do some funny things sometimes.

Copy the small macro below into a new workbook.

Change back from the VBA editor to Sheet1.

Go into File Open as if you are going to open a file and change into the
network folder (D:\costs or whatever folder you use) but do not open any
files. Close the fileopen window.

Run the Test_File_Path macro and then check the filepath in cell A1 on
Sheet1 and see whether it is the same as you have been using as the filepath.
If it is different, then try it as your filepath in the code.

Sub Test_File_Path()
Sheets("Sheet1").Range("A1") = CurDir
End Sub

If this does not work, then I suggest that you start a new thread on this
forum and post the code on it and describe what happens. Include the
information that it runs on your home computer but not on the network and
request that the MVP's look at it and see if they can tell you what is wrong.

Your suggestion is worth a thought but if it won't write to the spreadsheet
then I doubt that it will write to a txt file either.

Regards,

OssieMac

This will be my sign off on this problem because I certainly do not know the
answer.
MVP's are Most Valuable Professionals. A lot of news/forum sites are shared
and people sign in to different web sites to view the info. If you sign in on
the Microsoft communities web site then at the bottom of the window where you
read the posted info you will see a qustion re whether the post was helpful.
Immediately below that there is a question-link 'Why should I rate a post?'.
if you open that link, there is quite a lot of info including an explanation
of MVP's.

Best of luck for the future and I hope you do find an answer to the problem.

Regards,

OssieMac

Hi SAHRAYICEDIT and OssieMac -

Thanks to both of you for pursuing this problem. I for one, will certainly
be wary of applications that require opening many workbooks because of your
efforts. I'll keep my eyes open for information on the subject, but I don't
have any fertile ideas to add to this thread. I'll post or email in the
future if I come across information that addresses this issue.

Thanks again for all your efforts; they were educational and resulted in an
application that produces a valuable result in my computing environment and
will benefit others I'm sure.
--
Jay