S
Smits
Sub Use_of_FileSearch()
Dim MyDumpFiles As String
Dim MyPath As String
Set fs = Application.FileSearch
MyPath = "C:\Count" 'Change the folder location'
With fs
.LookIn = MyPath
.SearchSubFolders = True
.Filename = "*.xls"
If .Execute() > 0 Then
MsgBox "Number of excel file(s) found are: " & .FoundFiles.Count
For i = 1 To .FoundFiles.Count
MyDumpFiles = .FoundFiles(i)
Workbooks.Open MyDumpFiles
Worksheets(1).Activate
Range("A1:C10").Copy
ActiveWindow.ActivateNext
Worksheets(1).Activate
Range("A1:C10").PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Rows("1:11").Select
Selection.Insert Shift:=xlDown
ActiveWindow.ActivateNext
ActiveWorkbook.Close Savechanges = False
Next i
Else
MsgBox "No Excel File(s) Found"
End If
End With
End Sub
Dim MyDumpFiles As String
Dim MyPath As String
Set fs = Application.FileSearch
MyPath = "C:\Count" 'Change the folder location'
With fs
.LookIn = MyPath
.SearchSubFolders = True
.Filename = "*.xls"
If .Execute() > 0 Then
MsgBox "Number of excel file(s) found are: " & .FoundFiles.Count
For i = 1 To .FoundFiles.Count
MyDumpFiles = .FoundFiles(i)
Workbooks.Open MyDumpFiles
Worksheets(1).Activate
Range("A1:C10").Copy
ActiveWindow.ActivateNext
Worksheets(1).Activate
Range("A1:C10").PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Rows("1:11").Select
Selection.Insert Shift:=xlDown
ActiveWindow.ActivateNext
ActiveWorkbook.Close Savechanges = False
Next i
Else
MsgBox "No Excel File(s) Found"
End If
End With
End Sub