MACRO to copy data.xls file from different subfolders to dest folder and rename the file

[sanjay1982]

I would like to copy every file named "data.xls" from every subfolder found in the folder c:\test\ and want to save in "dest" folder with file name "data_1.xls","data_2.xls"....so on so. Each sub folder is named as 01022013,02022013,03022013.....and all are contain the file "data.xls"

 

[patel45]

not tested

Sub a()
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   oldpath = "c:\test\"
   newpath = "c:\dest\"
   Set mainFolder = objFSO.GetFolder(oldpath)
   n = 1
   For Each mySubFolder In mainFolder.subfolders
     Name = "data.xls"
     Name1 = "data_" & n & ".xls"
     FileCopy mySubFolder & Name, newpath & Name1
     n = n + 1
   Next
End Sub

 

[sanjay1982]

@mr patel

dear its not wo.after running macro it gives run time error 53"file not found"

and after debugging its highlighted the following line

FileCopy mySubFolder & Name, newpath & Name1

 

[patel45]

Sub a()
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   oldpath = "c:\test\"
   newpath = "c:\dest\"
   Set mainFolder = objFSO.GetFolder(oldpath)
   n = 1
   For Each mySubFolder In mainFolder.subfolders
     Name = "data.xls"
     Name1 = "data_" & n & ".xls"
     FileCopy mySubFolder [COLOR=#ff0000]& "\"[/COLOR] & Name, newpath & Name1
     n = n + 1
   Next
End Sub

 

[sanjay1982]

Thank u mr patel ..ur code is wo fine.thanks alot

 

[sanjay1982]

hello mr patel,
as i said that i have subfolders named as 01022013,02022013,03022013(these are the dates on which reports are generated) so can u add this at the end of file name like data_01022013,data_02022013,data_03022013 in place of data_1,data_2 ...

 

[patel45]

i'm not sure about understanding, try

Sub a()
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   oldpath = "c:\test\"
   newpath = "c:\dest\"
   Set mainFolder = objFSO.GetFolder(oldpath)
   For Each mySubFolder In mainFolder.subfolders
     Name = "data.xls"
     Name1 = "data_" & mySubFolder & ".xls"
     FileCopy mySubFolder [COLOR=#ff0000]& "\"[/COLOR] & Name, newpath & Name1
   Next
End Sub

 

[sanjay1982]

its not wo and giving run time error '52' "bad file name or number"

actually in process of rename its added the path with original file name like NAME1=DATA_C:\TEST\01022013.XLS

Name1 = "data_" & mySubFolder & ".xls"

FileCopy mySubFolder & "\" & Name, newpath & Name1

 

[patel45]

Sub a()
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   oldpath = "c:\test\"
   newpath = "c:\dest\"
   Set mainFolder = objFSO.GetFolder(oldpath)
   For Each mySubFolder In mainFolder.subfolders
     Name = "data.xls"
     p=instrrev(mySubFolder,"\")
     Name1 = "data_" & right(mySubFolder, len(mySubFolder)-p) & ".xls"
     FileCopy mySubFolder [COLOR=#ff0000]& "\"[/COLOR] & Name, newpath & Name1
   Next
End Sub

 

[sanjay1982]

thanks alot ur code is giving fine result...