[已解决]提取文件夹内所有文件名的求助

hhxq001 · 发表于 2023-1-12 16:12

在网上找到的提取文件夹及子文件夹内所有文件名，现在有2个问题解决不了，1是加提取序号，2是要求不能提取本汇总表的文件名，怎么解决，求助朋友们

提取本文件夹及子文件夹内所有的文件名-问题.rar (44.57 KB, 下载次数: 2)

zjdh · 发表于 2023-1-12 17:10

新建文件夹 (2).rar (44.21 KB, 下载次数: 6)

hhxq001 · 发表于 2023-1-12 18:06

zjdh 发表于 2023-1-12 17:10

感谢帮助，不过提取后出现2处不应该有的东西，看图

zjdh · 发表于 2023-1-12 22:13

新建文件夹 (3).rar (44.19 KB, 下载次数: 10)

hhxq001 · 发表于 2023-1-13 10:09

Sub 提取包含子文件夹()
With Application.FileDialog(msoFileDialogFolderPicker) '获取用户选择文件夹的路径
      .Title = "请选择文件夹"
      .InitialFileName = ThisWorkbook.Path & "\"          '默认打开当前目录"
      If .Show = 0 Then MsgBox "本次提取已被取消！！": Exit Sub '如果没有选择保存路径，则退出程序
      myPath$ = .SelectedItems(1) '选择的文件路径赋值给变量P
End With

If Right(myPath, 1) <> "" Then myPath = myPath & ""
[a:b].ClearContents '清空汇总表的A-B列原有数据
[a1] = "序号" '汇总表的a1写入。。。。
[b1] = " 文件名如下：" '汇总表的b1写入。。。。
Call ListAllFso(myPath) '调用FSO遍历子文件夹的递归过程
End Sub

Function ListAllFso(myPath$) '用FSO方法遍历并列出所有文件和文件夹名的【递归过程】
Set fld = CreateObject("Scripting.FileSystemObject").GetFolder(myPath)
'用FSO方法得到当前路径的文件夹对象实例注意这里的【当前路径myPath是个递归变量】

For Each f In fld.Files '遍历当前文件夹内所有【文件.Files】
      If InStr(f.Name, ThisWorkbook.Name) Then GoTo 10 '要提取的文件名不能是本文件
      [B65536].End(3).Offset(1) = fld & "\" & f.Name '在b列逐个列出文件名
      [B65536].End(3).Offset(, -1) = [A65536].End(3).Row '在a列填写序号
10  Next
For Each fd In fld.SubFolders '遍历当前文件夹内所有【子文件夹.SubFolders】
      Call ListAllFso(fd.Path) '注意此时的路径变量已经改变为【子文件夹的路径fd.Path】
      '注意重点在这里：继续向下调用递归过程【遍历子文件夹内所有文件文件夹对象】
Next
ActiveSheet.Range("a1:a1000").HorizontalAlignment = xlCenter 'a列数据=水平居中
End Function

		自动登录	找回密码
密码			注册

[已解决]提取文件夹内所有文件名的求助

评分