Consolidate Files From Mutiple Sub Folders into One Folder

[xlUser]

Hi,

I have several folders and sub folders each containing files that I would like to consolidate into one central folder.

So for example my main folder is called test sitting at

c:\Test

Within this folder I have several folders: D1, D2, D3

c:\Test\d1

With each one of these folders I have another folder called data. And it is within this folder where the files that I wiould like to consolidate into one place reside (in this case excel files). So there are three levels of folders:

c:\Test\d1\data\Actual Files
c:\Test\d2\data\Actual Files
c:\Test\d3\data\Actual Files
c:\Test\d4\data\Actual Files
ETC

I would like to copy the files from each "data" folder into one main central folder (e.g folder called All) or into the test folder itself.

I've searched the internet on trying to find an example to do this but have been unsuccessful, hope someone can help.

Thanks,

Excel User

[mohanvijay]

Try this

[vba]
Const L_Fol_Ma As String = "c:\test"
Const L_Fol_con As String = "c:\all\"
Const L_File_Ext As String = ",XLS,XLSX,XLSB,XLSM,"
Dim FSO As Object
Dim F_Fol1 As Object
Dim F_Fol2 As Object
Dim F_Fol3 As Object
Dim F_File As Object
Dim Hld_Ver As Variant
Dim T_Str As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set F_Fol1 = FSO.getfolder(L_Fol_Ma)
For Each F_Fol2 In F_Fol1.SubFolders
If FSO.FolderExists(F_Fol2.Path & "\data") Then
Set F_Fol3 = FSO.getfolder(F_Fol2.Path & "\data")


For Each F_File In F_Fol3.Files
Hld_Ver = Split(F_File.Path, ".")
T_Str = UCase(Hld_Ver(UBound(Hld_Ver)))
T_Str = "," & T_Str & ","
If InStr(L_File_Ext, T_Str) > 0 Then
FileCopy F_File.Path, L_Fol_con & F_File.Name
End If
Next

Set F_Fol3 = Nothing
End If
Next
Set F_File = Nothing
Set F_Fol2 = Nothing
Set F_Fol1 = Nothing
Set FSO = Nothing
[/vba]