历遍筛选文件夹及其子文件夹下所有文件

yl1991

doryan 发表于 2012-4-1 08:39
额  我主要还是想知道在Dos下的实现方法 嘿
VBA下倒是很简单的

怎么做呀？

wcm_xp

高手啊。学习不断进步。。能否再加两列文件大小和日期啊。。请教

平東

老师，你这个只筛选xls的没有筛选出xlsx，如何实现两种文件筛选呢？

OALD

大家试试这个吧

1. Option Explicit
   
2. 
   
3. Sub 父子转换法()
   
4.     Dim FatherFolder(1 To 10000) As String
   
5.     Dim f, i, k, f2, f3, x
   
6.     Dim arr1(1 To 100000, 1 To 1) As String, q As Integer
   
7.     FatherFolder(1) = ThisWorkbook.Path & ""
   
8.     i = 1: k = 1
   
9.     Do While i < UBound(FatherFolder)
   
10.         If FatherFolder(i) = "" Then Exit Do
    
11.         f = Dir(FatherFolder(i), vbDirectory)
    
12.         Do
    
13.             If InStr(f, ".") = 0 And f <> "" Then
    
14.                 k = k + 1
    
15.                 FatherFolder(k) = FatherFolder(i) & f & ""
    
16.             End If
    
17.             f = Dir
    
18.         Loop Until f = ""
    
19.         i = i + 1
    
20.     Loop
    
21.    
    
22.     '提取各文件夹中的文件
    
23.     For x = 1 To UBound(FatherFolder)
    
24.         If FatherFolder(x) = "" Then Exit For
    
25.         f3 = Dir(FatherFolder(x) & "*.*")
    
26.         Do While f3 <> ""
    
27.             q = q + 1
    
28.             arr1(q, 1) = FatherFolder(x) & f3
    
29.             f3 = Dir
    
30.         Loop
    
31.     Next x
    
32.     ActiveSheet.UsedRange = ""
    
33.     Range("a1").Resize(q) = arr1
    
34. End Sub

复制代码

zyh8110

请问一下，在哪一行插入自己需要运行的宏了？

无雨谷

zyh8110 发表于 2021-12-4 09:35
请问一下，在哪一行插入自己需要运行的宏了？

ALT+F11打开，输入

zyh8110

无雨谷 发表于 2021-12-4 09:47
ALT+F11打开，输入

Sub test()
Dim a(), d As New DataObject
ReDim a(9999)
ZDir ThisWorkbook.Path & "\", a, "xls"
d.SetText Join(a, vbNewLine)
d.PutInClipboard
Sheet1.Paste [a1]
Set d = Nothing
End Sub

Sub ZDir(ByRef P, ByRef a(), Optional s$)
Dim d As New Dictionary
With CreateObject("scripting.FileSystemObject")
  d(P) = ""
  While d.Count - i
    For Each cc In .GetFolder(d.Keys(i)).SubFolders
      d(cc) = ""
    Next
    i = i + 1
  Wend
  For Each ct In d.Keys
  For Each cc In .GetFolder(ct).Files
    If cc Like "*" & s Then a(n) = cc: n = n + 1
  Next
Next
End With
ReDim Preserve a(n - 1)
Set d = Nothing
End Sub

1、这个不能自己浏览指定文件夹路径  2、不清楚在哪一行插入自己的宏    谢谢

zyh8110

无雨谷 发表于 2021-12-4 09:47
ALT+F11打开，输入

打开之后哪一行了 ?      而且这个也不能指定文件夹位置吗？

1249994139

Zamyi 发表于 2012-3-28 09:21
的确，用递归更简洁，不用字典更好：

下载了学习，谢谢提供分享。好东东