******如何复制各个文件夹里的工作薄到一个文件夹里？******

yu88

如何复制各个文件夹里的工作薄到一个文件夹里？

如果“提取到这文件夹里”的主表E1单元格是“7月”，就提取各文件夹里的各工作薄名包含7月的表，到“提取到这文件夹里”
0802.rar (43.86 KB, 下载次数: 30)

2014-8-2 16:13 上传

点击文件名下载附件

上面问题能实现的话
另外如果各店文件夹在F;\店铺   “提取到这文件夹里”在E:\  有没有办法实现上述的复制？

jsxjd

其实有必要进行复制吗？
实现应该是没问题的，复制前是否清除目标文件夹，当然除主控工作簿

zhong1218

1. Sub GetFiles()
   
2.     Dim Fso, fds, fd, folser1, folder2, fs, f, mypath$, myname$
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     mypath = Replace(ThisWorkbook.Path, "\提取到这文件夹里", "")
   
6.     Set Fso = CreateObject("Scripting.FileSystemObject")
   
7.     Set folder1 = Fso.GetFolder(mypath) '获得文件夹
   
8.     Set fds = folder1.SubFolders         '子文件夹集合
   
9.     For Each fd In fds                   '遍历子文件夹
   
10.         If fd.Name <> "提取到这文件夹里" Then
    
11.             Set folder2 = fd                 '获得文件夹2
    
12.             Set fs = folder2.Files           '文件集合
    
13.             For Each f In fs                 '遍历文件
    
14.                 If InStr(f.Name, Cells(1, 5).Value) Then
    
15.                     FileCopy mypath & "" & fd.Name & "" & f.Name, mypath & "\提取到这文件夹里" & f.Name
    
16.                 End If
    
17.             Next
    
18.         End If
    
19.     Next
    
20.     Application.DisplayAlerts = True
    
21.     Application.ScreenUpdating = True
    
22. End Sub

复制代码

yu88

jsxjd 发表于 2014-8-2 17:33
其实有必要进行复制吗？
实现应该是没问题的，复制前是否清除目标文件夹，当然除主控工作簿

谢谢，jsxjd版主，因为有很多店铺的文件夹需要复制到一个文件夹里
目标文件夹不用清除，只是复制就行

liulang0808

http://club.excelhome.net/blog-238368-1693.html
fso的资料，可以参考这个实现

yu88

zhong1218 发表于 2014-8-2 17:35

另外如果各店文件夹在F：\店铺\  
“提取到这文件夹里”在E:\        有没有办法实现上述的复制？

zhong1218老师，麻烦再帮我考虑下这个问题，谢谢

zhong1218

yu88 发表于 2014-8-2 18:28
另外如果各店文件夹在F：\店铺\  
“提取到这文件夹里”在E:\        有没有办法实现上述的复制？

1. Sub GetFiles()
   
2.     Dim Fso, fds, fd, folser1, folder2, fs, f, mypath$, myname$
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     mypath = "F:\店铺"
   
6.     Set Fso = CreateObject("Scripting.FileSystemObject")
   
7.     Set folder1 = Fso.GetFolder(mypath) '获得文件夹
   
8.     Set fds = folder1.SubFolders         '子文件夹集合
   
9.     For Each fd In fds                   '遍历子文件夹
   
10.         Set folder2 = fd                 '获得文件夹2
    
11.         Set fs = folder2.Files           '文件集合
    
12.         For Each f In fs                 '遍历文件
    
13.             If InStr(f.Name, Cells(1, 5).Value) Then
    
14.                 FileCopy mypath & "" & fd.Name & "" & f.Name, "E:\提取到这文件夹里" & f.Name
    
15.             End If
    
16.         Next
    
17.     Next
    
18.     Application.DisplayAlerts = True
    
19.     Application.ScreenUpdating = True
    
20. End Sub

复制代码

改下路径就可以了

jiminyanyan

关注一下。。。。。

jiminyanyan

路径可以选择，楼主可自行完善。。。。。。

jjmysjg

jiminyanyan 发表于 2014-8-3 13:06
路径可以选择，楼主可自行完善。。。。。。

文件无法运行，怎么回事？