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

kimmyyang

这个确实有用，厉害厉害

C哥

优秀！学习了

jave000

liulang0808 发表于 2014-11-15 09:11
三、遍历当前文件夹所有子文件夹
使用了递归。。。。
Sub 按钮1_Click()

我只要若干目录的第一层子文件夹的路径。
使用以下代码，请问这个代码如何才能支持多个路径？显示debug在set ff的路径这一行。
Sub Button_Click()
    Application.ScreenUpdating = False
    Set fso = CreateObject("scripting.filesystemobject")
    Set ff = fso.getfolder("\\caojsvr5.ad.glpoly.net\PUR_SIB\" & "\\caojsvr5.ad.glpoly.net\PUR_SIB\PUR_MOC\Logistic\" & "\\caojsvr5.ad.glpoly.net\PUR_SIB\PUR_MOC\MDI\C1\" & "\\caojsvr5.ad.glpoly.net\PUR_SIB\PUR_MOC\MDI\C2\" & "\\caojsvr5.ad.glpoly.net\PUR_SIB\PUR_MOC\PUR\" & "\\caojsvr5.ad.glpoly.net\PUR_SIB\PUR_MOC\TDI\C1\Under_Working\" & "\\caojsvr5.ad.glpoly.net\PUR_SIB\PUR_MOC\TDI\C2\")
    ActiveSheet.UsedRange.ClearContents
    a = 1
    For Each fd In ff.subfolders
        Cells(a, 1) = fd
        a = a + 1
    Next fd
    Application.ScreenUpdating = True
End Sub

我又试着使用以下代码，结果只生成了根目录下第一个子文件夹的所有子文件夹路径，其他的都不生成。有时直接无法运行，显示debug在For Each fd In ff.subfolders这一行。请问这个代码是否支持只要往下二层子文件夹的设置？
Sub Button_Click()
    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.ClearContents
    Cells(1, 1) = "Project Folder Name"
    Getfd ("\\caojsvr5.ad.glpoly.net\PUR_SIB\")
    Application.ScreenUpdating = True
End Sub
Sub Getfd(ByVal pth)
    Set Fso = CreateObject("scripting.filesystemobject")
    Set ff = Fso.getfolder(pth)
    Cells(Rows.Count, 1).End(3).Offset(1) = pth
    For Each fd In ff.subfolders
        Getfd (fd)
    Next fd
End Sub

无雨谷

谢谢分享，学习了

lusa

很好很强大，希望我能做出来我要的VBA

明天会更好zj

学习了！感谢分享！

bsyjfen

很好用，学习了。

33502

刚好用上了,非常感谢

wangyuhui7

liulang0808 发表于 2014-11-15 09:11
三、遍历当前文件夹所有子文件夹
使用了递归。。。。
Sub 按钮1_Click()

Sub Macro1()
    Application.ScreenUpdating = False
    For Each f In CreateObject("scripting.filesystemobject").getfolder(ThisWorkbook.Path).Files
        If InStr(f.Name, ThisWorkbook.Name) = 0 Then
            With Workbooks.Open(f)
                For Each sh In .Sheets
                    sh.DrawingObjects.Delete
                Next sh
                .Save
                .Close True
            End With
        End If
    Next f
    Application.ScreenUpdating = True
End Sub
你好，版主  这是你之前写的一个删除目录excel里面图片的代码，我想问的是如何用遍历当前文件夹及所有子文件夹下的文件把子目录里面excel图片也删除，看了你FSO案例没太明白，你帮我写下，看在上面加那几句代码就可以，非常感谢！

liulang0808

wangyuhui7 发表于 2022-5-13 13:43
Sub Macro1()
    Application.ScreenUpdating = False
    For Each f In CreateObject("scripting.fi ...

看递归那个案例