fso提取汇总文件夹及其下的文件名及内容（递归操作字典汇总）

iwangyi

看了三遍了

seusbc

太厉害了，刚开始学习VB，还看不懂，
但这个功能用的到，慢慢学把
谢谢 分享

老鬼公公_31

慢慢学习，留记号

lzqmsy

留个记号,学习方便,谢谢楼主!!!

tvxqyanger

liulang0808 发表于 2014-11-15 09:08
一、遍历当前文件夹下一层子文件夹
Sub 按钮1_Click()
    Application.ScreenUpdating = False

如果加一个条件。比如获取了文件夹名称后，判断他是否和一个单元格内容相同，相同的话就dir获取第二列中对应行的路径？

新手来习

谢谢分享，学习了

WXY075675

那位大师能帮我用VBA做个统计表吗？就是把文件夹里有的材料按文件名在统计表里打勾，没有的留空，谢谢了！

liulang0808

WXY075675 发表于 2018-12-9 11:31
那位大师能帮我用VBA做个统计表吗？就是把文件夹里有的材料按文件名在统计表里打勾，没有的留空，谢谢了！
...

1. Sub 按钮1_Click()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Set fso = CreateObject("scripting.filesystemobject")
   
4.     Application.ScreenUpdating = False
   
5.     For Each fd In fso.getfolder(ThisWorkbook.Path).subfolders
   
6.         For Each f In fd.Files
   
7.             str1 = Split(f.Name, ".")(0)
   
8.             d(fd.Name & str1) = "√"
   
9.         Next f
   
10.     Next fd
    
11.     [c4:d13].ClearContents
    
12.     Set Rng = Nothing
    
13.     For j = 4 To 13
    
14.         For i = 3 To 4
    
15.             If d.exists(Cells(3, i) & Cells(j, 2)) Then
    
16.                 Cells(j, i) = d(Cells(3, i) & Cells(j, 2))
    
17.             Else
    
18.                 If Rng Is Nothing Then
    
19.                     Set Rng = Cells(j, i)
    
20.                 Else '
    
21.                     Set Rng = Union(Rng, Cells(j, i))
    
22.                 End If
    
23.             End If
    
24.         Next i
    
25.     Next j
    
26.     If Not Rng Is Nothing Then Rng.Interior.ColorIndex = 3
    
27.     Application.ScreenUpdating = True
    
28. End Sub

复制代码

华南兔

太有用了，感谢大侠。

carpli

多谢老师，非常有用！