求能分别对总文件夹各子文件夹内的Excel文档进行操作的宏

szqhb

见附件
附件中有个“Excel批量操作宏”文档，执行它可以对“总文件夹”内的Excel文档进行相同的操作
如何修改里面的代码，使它能分别自动对“总文件夹”里各子文件夹内的Excel文档进行相同的操作？？
不知道有没有叙述清楚

[ 本帖最后由 szqhb 于 2010-11-25 00:21 编辑 ]

Admin

   

很遗憾通知楼上朋友，您的帖子在24小时之内没有任何回复！

通常情况下，本论坛发布的主题帖会在8小时被回复或处理。您的帖子在24小时之内未被回复，其中的原因可能是：

1、问题表述不清、模棱两可，难以理解，帮助者被搞晕了，夺帖而出；
2、没有上传必要的附件，或附件被遗忘在某个角落；
3、发帖提问时，语气带棱角、带挑衅，不幸被列入不受欢迎的帖子；
4、所提问题不成立，或提不合理的要求，乐于助人者使出“走为上”之计；
5、话题较偏、较冷或者发布到了不合适的版块，暂时无人问津，顾影自怜。


为了提高您的问题解决效率，我们推荐您阅读以下文章：
* 如何发表新话题和上传附件：http://club.excelhome.net/thread-45649-1-1.html
* 发帖的技巧：http://club.excelhome.net/thread-176339-1-1.html
* EH技术论坛的最佳学习方法：http://club.excelhome.net/thread-117862-1-1.html

szqhb

希望有人能帮到我

jiminyanyan

1. Sub test()
   
2.     Dim fd As FileDialog
   
3.     Dim Path As String, Name As String
   
4.     Dim T$, i%
   
5. 
   
6.     On Error GoTo line1 '当产生错误的时候跳转到line1行，退出程序
   
7.    
   
8.     Set fd = Application.FileDialog(msoFileDialogFolderPicker) '使用 FileDialog 对象显示"文件选取器"对话框
   
9.     With fd
   
10.         If .Show = -1 Then '如果选择了确定按钮，则（.show的值等于0，表示按取消按钮）
    
11.             T = .SelectedItems(1) & "" '用T记录下它的路径
    
12.         Else
    
13.             Set fd = Nothing: Exit Sub '按取消之后就退出程序
    
14.         End If
    
15.     End With
    
16. 
    
17.     Application.ScreenUpdating = False '关闭屏幕更新，防止闪屏及加快代码执行
    
18.     Application.EnableEvents = False '不运行除本程序之外的其它程序，如新工作簿被打开时运行的open程序等
    
19.     Application.DisplayAlerts = False '关闭各种警告和消息，选择默认应答
    
20. 
    
21.     With Application.FileSearch '建立一个新的搜索
    
22.         .LookIn = T '范围为先前的路径
    
23.         .SearchSubFolders = True '搜索范围包含当前路径下的子文件夹
    
24.         .Filename = "*.xls" '搜索的程序名称为excel表
    
25.         .Execute msoSortByFileName '执行搜索过程，并按文件名称排序，后面的排序参数可以省略
    
26.         For i = 1 To .FoundFiles.Count
    
27.             s = .FoundFiles(i)
    
28.             BreakdownName s, Path, Name '把s分解成路径名和表名
    
29.             Set wb = Workbooks.Open(s) '打开这个工作簿
    
30.             For Each shtExcel In wb.Sheets '在这个工作簿里的每个工作表里循环
    
31.                 shtExcel.Range("a2") = shtExcel.Name
    
32.                      Next
    
33.             wb.Close True '保存打开的工作簿
    
34.         Next i
    
35.     End With
    
36.    
    
37. line1:
    
38.     Application.ScreenUpdating = True '重新设置系统，为程序运行之前的设置
    
39.     Application.EnableEvents = True
    
40.     Application.DisplayAlerts = True
    
41. End Sub
    
42. Sub BreakdownName(ByVal s As String, ByRef Path As String, ByRef Name As String)    'byref表示按引用来传递
    
43. 'byval表示按值来传递，一般情况省略
    
44.     Dim a
    
45.     a = Split(s, "")    '按\分成一个数组
    
46.     Name = a(UBound(a))    '取数组的最大一个，即表名
    
47.     Path = Left(s, Len(s) - Len(Name) - 1)  '取路径
    
48. End Sub
    
49. '效果类似于下面的：
    
50. 's = C:\Documents and Settings\hujinsong\桌面\按值来传递.xls
    
51. 'Path C:\Documents and Settings\hujinsong\桌面'name 按值来传递.xls
    
52. 
    
53. 
    

复制代码

代码参考龙三老师的。

[ 本帖最后由 jiminyanyan 于 2010-11-15 07:52 编辑 ]

szqhb

谢谢liminyanyan老师的帮助，我看看能不能用
经测试，能用

[ 本帖最后由 szqhb 于 2010-11-25 00:22 编辑 ]