This will get a list of all .xls files in that folder and all subfolders. You
can process them after you have the list:

Option Explicit
Dim myFileNames() As String
Dim fCtr As Long
Sub testme()

Dim FinalFolderName As String
Dim CurrentFolderName As String

Dim FSO As Object
Dim CurrentFolder As Object
Dim myFolder As Object
Dim myFile As Object

' Dim FSO As Scripting.FileSystemObject
' Dim CurrentFolder As Scripting.Folder
' Dim myFolder As Scripting.Folder
' Dim myFile As Scripting.File

CurrentFolderName = "C:\my documents\excel"

Set FSO = CreateObject("Scripting.FileSystemObject")
' Set FSO = New Scripting.FileSystemObject

If FSO.FolderExists(CurrentFolderName) = False Then
MsgBox "Not a good starting folder"
Exit Sub
End If

Set CurrentFolder = FSO.GetFolder(CurrentFolderName)

fCtr = 0
For Each myFile In CurrentFolder.Files
If LCase(Right(myFile.Name, 4)) = ".xls" Then
fCtr = fCtr + 1
ReDim Preserve myFileNames(1 To fCtr)
myFileNames(fCtr) = myFile.Path
End If
Next myFile

If fCtr = 0 Then
MsgBox "no files found"
Exit Sub
End If

'process your files here
For fCtr = LBound(myFileNames) To UBound(myFileNames)
MsgBox myFileNames(fCtr)
Next fCtr

End Sub



excel-tr wrote:

hi,

below code ( from ron s site ) is for copying worksheets in different
workbooks in one folder,
how can we revise it to search subfolders as well ?

regards
Sub Example11()
Dim basebook As Workbook
Dim mybook As Workbook
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String


SaveDriveDir = CurDir
MyPath = "D:\folder"


ChDrive MyPath
ChDir MyPath

FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook

Do While FNames < ""
Set mybook = Workbooks.Open(FNames)

mybook.Worksheets.Copy after:= _
basebook.Sheets(basebook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = mybook.Name ' Or use Left(mybook.Name,
Len(mybook.Name) - 4)
On Error GoTo 0

' You can use this if you want to copy only the values
' With ActiveSheet.UsedRange
' .Value = .Value
' End With

mybook.Close False
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

--
SAHRAYICEDIT-ISTANBUL

--

Dave Peterson