麻烦老师帮忙写个提取子文件夹里文件名的代码

q490525427

首先启动默认桌面文件夹，用户再选择文件夹，
案例是提取（平铺）子文件里的文件名

然后用INPUTBOX框用户输入要提取文件名的子文件夹
（不限制几级子文件夹，只要包含就提取）
只要文件名，不要文件的后缀名


放在A列，从第二行开始，每个文件夹里面的文件名，中间隔一行，好分辨
加个任意字体颜色
谢谢了..

limonet

算了，写了你不一定能运行。

q490525427

limonet 发表于 2024-8-21 13:45
算了，写了你不一定能运行。

好吧，感谢老师回帖

ykcbf1100

将就着用吧

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.8.21
   
2.     Application.ScreenUpdating = False
   
3.     Set fso = CreateObject("Scripting.FileSystemObject")
   
4.     '  p = CreateObject("Wscript.Shell").SpecialFolders("Desktop") & ""   '//桌面路径
   
5.     p = ThisWorkbook.Path & ""        '//实际使用时,把这句换成上面那句
   
6.     ReDim brr(1 To 10000, 1 To 1)
   
7.     With Application.FileDialog(msoFileDialogFolderPicker)
   
8.         .Title = "请选择文件夹"
   
9.         .InitialFileName = p
   
10.         If .Show = -1 Then
    
11.             p = .SelectedItems(1) & ""
    
12.         End If
    
13.     End With
    
14.     fn = Application.InputBox("请输入子文件夹名", "子文件夹名", "")
    
15.     If Len(fn) = 0 Then Exit Sub
    
16.     getfiles p, brr, m, fso
    
17.     With Sheets("Sheet1")
    
18.         .[a2].Resize(10000, 1) = ""
    
19.         .[a2].Resize(m, 1) = brr
    
20.     End With
    
21.     Application.ScreenUpdating = True
    
22.     MsgBox "OK！"
    
23. End Sub
    
24. 
    
25. Function getfiles(p, brr, m, fso)
    
26.     For Each fd In fso.GetFolder(p).SubFolders
    
27.         If InStr(fd.Name, fn) Then
    
28.             For Each f In fd.Files
    
29.                 m = m + 1
    
30.                 brr(m, 1) = fd.Name & ":" & fso.GetBaseName(f)
    
31.             Next
    
32.             getfiles fd, brr, m, fso
    
33.         End If
    
34.     Next
    
35. End Function
    

复制代码

q490525427

ykcbf1100 发表于 2024-8-21 14:07
将就着用吧

好的，谢谢老师

q490525427

ykcbf1100 发表于 2024-8-21 14:07
将就着用吧

你好老师，问一下，有没有办法实现，提取后的数据顺序和文件夹的顺序一样呢