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

wangyuhui7

liulang0808 发表于 2022-5-13 18:06
看递归那个案例

嗯嗯   看了   没太懂，初学者

liulang0808

wangyuhui7 发表于 2022-5-13 18:57
嗯嗯   看了   没太懂，初学者

Sub 按钮1_Click()
    Set fso = CreateObject("scripting.filesystemobject")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Call Getfd(ThisWorkbook.Path, fso)
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
Sub Getfd(ByVal pth, fso)
    Set ff = fso.getfolder(pth)
    For Each f In ff.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
    For Each fd In ff.subfolders
        Call Getfd(fd, fso)
    Next fd
End Sub

liulang0808

wangyuhui7 发表于 2022-5-13 18:57
嗯嗯   看了   没太懂，初学者

模拟案例供参考

wangyuhui7

liulang0808 发表于 2022-5-13 20:39
模拟案例供参考

好的  非常感谢老师的指点
再请教下  word中VBA遍历目录子文件也是一个方法吗？下面代码是word中.doc文件批量转.docx, 还是想让子目录中的.doc文件一次性转换，这个怎么加遍历代码，感谢感谢！

Sub doc2docx()
Dim myDialog As FileDialog, oFile As Variant
Set myDialog = Application.FileDialog(msoFileDialogFilePicker)
With myDialog
.Filters.Clear
.Filters.Add "所有 WORD97-2003 文件", "*.doc", 1
.AllowMultiSelect = True
If .Show = -1 Then
For Each oFile In .SelectedItems
With Documents.Open(oFile)
.ComputeStatistics (wdStatisticPages)
.SaveAs FileName:=oFile + "x", FileFormat:=wdFormatXMLDocument
.Close
End With
Next
End If
End With
End Sub

jave000

https://club.excelhome.net/home. ... wall&from=space
求助大神代码是否支持指定的默认路径，而非我的电脑根目录。
求助能否支持遍历指定多关键词的子文件夹（层级随机）

liulang0808

jave000 发表于 2022-6-23 10:50
https://club.excelhome.net/home.php?mod=space&uid=238368&do=wall&from=space
求助大神代码是否支持指 ...

支持指定默认路径的，楼主可以根据需求设置测试
指定关键字文件夹，这个遍历的文件夹，然后判断这个文件夹是否包含指定关键字，然后再进一步确认如何处理的

jave000

liulang0808 发表于 2022-6-23 21:26
支持指定默认路径的，楼主可以根据需求设置测试
指定关键字文件夹，这个遍历的文件夹，然后判断这个文件 ...

Public Fso As Object
Sub getFldList()
     Set Fso = CreateObject("Scripting.FileSystemObject")
     Fldnm (CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件夹", 0, "").Self.Path & "\")
End Sub


Function Fldnm(pth$)
     Dim Fld   
    [A65536].End(3)(2) = pth
     For Each Fld In Fso.getfolder(pth).subfolders
         Fldnm (Fld)
     Next
End Function




就是以上代码，请问默认路径可以写在哪。或者不用默认，但是调用的路径窗口是新款支持复制路径链接也行，当前的是旧款，只能挨个点进去，但我们网盘不在默认可选中。
关键字的我试试吧，不太懂。
谢谢

jave000

Sub Button1_Click()
    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.ClearContents
    Cells(1, 1) = "path name"
    Getfd ("C:\Users\Others\")
    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

这段代码运行顺利，目前测试一千个路径没问题、但是换到上万个子目录路径就报错，请问如何才能支持？

jave000

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

这段代码一直使用正常，但是上海封城期间就不能用了，显示错误wrong number of arguments or invalid property assignment

hasyh2008

版主就是版本啊！！！！！水平实在是高！！！