'on error resume next
dim k,oFso,currentpath
k=0
set oFso=createobject("scripting.filesystemobject")
Function FilesTree(oSubFolder)  '遍历一个文件夹下的所有文件夹文件夹  
    dim sPath,sName
     sPath = oSubFolder.Path
     sName = oSubFolder.Name
    Set oFolder = oFso.GetFolder(sPath)  
         
    Set oFiles = oFolder.Files  
    For Each oFile In oFiles  
       ' Msgbox oFile.Path  
        'oFile.Delete  
        
        oFso.copyfile oFile,currentpath+"\back\"+sName +oFile.Name
    Next  
          
    Set oFolder = Nothing  
    Set oSubFolders = Nothing  
   ' Set oFso = Nothing  
End Function 

currentpath = createobject("Scripting.FileSystemObject").GetFolder(".").Path

Set oFolder = oFso.GetFolder(currentpath) 
  Set oSubFolders = oFolder.SubFolders 
   For Each oSubFolder In oSubFolders  
        
        'oSubFolder.Delete
        if (oSubFolder.Name<>"back")then
         ' Msgbox oSubFolder.Name  
          FilesTree(oSubFolder)'递归  
        end if
    Next  
    
    Msgbox "处理完成"

'FilesTree(currentpath)

'Msgbox currentpath
'set f=fso.getfolder(currentpath)
'fso.createfolder("f:\bak")
'Set oSubFolders = oFolder.SubFolders
'set fs=f.files
'for each f1 in fs

'Msgbox f1
'if instr(f1,".txt")<>0 then
'k=k+1
'fso.copyfile f1,"f:\bak\"&k&".txt"
'end if
'next