判断文件夹存在

学习资源：《Excel VBA从入门到进阶》第49集 by兰色幻想

上节学了怎么遍历一个文件夹的文件，那么假设文件夹里还有文件夹，要怎么获取某文件夹下所有文件和子文件夹下的所有文件路径呢？

根据之前所学的，一旦定义了路径，dir函数只会在该路径下循环查找文件，而不会进入子文件夹。

节选一小段回顾：

  1. Filename = Dir(mypath, vbDirectory)
  2. Do
  3. k = k + 1
  4. Cells(k, 1) = Filename
  5. Filename = Dir
  6. Loop Until Filename = ''

到文件名为空之后，dir函数就结束运算。没有继续到1月、2月、3月、测试新建文件夹去寻找和返回文件。

那如何实现这一个功能？

有两种方法，第一种叫FileSearch，这种方法似乎只能在2003版的excel中运行，在其他版本运行都会出错，所以这里就略过不记录了。

第二种叫做父子转换法，dir函数和数组的综合应用。

父子转换法

  1. 思路：先找出所有文件夹路径，再找出所有文件夹下的文件路径。

① 设置一个数组arr1放置文件夹的路径，一个数组arr2放路径下所有的文件的路径。

提示：定义足够大的数组大小，思考定义为几维数组，arr2是要最终输出为一列的。

②首先获取要搜索的文件夹路径，这是第一个父文件夹，如果没设定，程序也不必运行。

提示：使用FileDialog对象选取文件夹路径，并返回给程序。

③设置循环，获取每一个子文件夹的路径，和进入子文件夹继续获取，直至所有路径下再也没有文件夹出现，

提示：使用两层循环，一层是循环查找所有父文件夹下面的子文件夹，一层是循环记录一个父文件夹下面的子文件夹路径，子文件夹可转换为父文件夹。直至没有新的子文件夹出现，循环结束。

④找完所有文件夹路径后，在每个文件夹路径下循环查找文件。同样两层循环，一层是循环文件夹路径，一层是循环查找文件。

⑤最后输出所有文件路径。

2. 图文解说：

  • 设置一个数组arr1放置文件夹的路径，一个数组arr2放路径下所有的文件的路径。一层是循环查找所有父文件夹下面的子文件夹，循环变量设为i，另一层是循环记录一个父文件夹下面的子文件夹路径，循环变量设为k。初始值i=1,k=1.

  • 获取要查找的文件夹路径，放在arr1(i)，i=1。

  • 查找arr1(1)的子文件夹，它有两个子文件夹，逐一填入arr1，k=k+1，填入(k+1)和arr1(k+2)，即arr1(2)和arr1(3)。

  • i=i+1，查找arr1(2)的子文件夹，它有三个子文件夹，k=k+1，逐一填入arr1(4)、arr1(5)、arr1(6)。

  • ……如此循环，获取到所有文件夹的路径。

  • 循环查找并获取arr1里文件夹路径下的文件路径放入arr2，然后输出即可。

PS:查找速度比记录速度慢，所以要用两个变量分别记录，查询到最后，i肯定是等于k，所以一旦i大于k，意味着已经查找完所有子文件夹了，立即停止循环。

3. 代码

Sub 父子转换法()Dim arr1(1 To 10000) As StringDim f, i, k, F2, f3, xDim arr2(1 To 100000, 1 To 1) As String, q As IntegerDim digSet dig = Application.FileDialog(msoFileDialogFolderPicker)With dig.Title = '请选择需要查找的文件夹''如果沒选择文件夹路径退出程序，选择了就返回文件地址到arr1(1)If .Show = 0 ThenExit SubElse'如果选择的是驱动盘，如D:，那就不需要在后面加''If VBA.Right(.SelectedItems(1),1) = '' Then   arr1(1) = .SelectedItems(1)Elsearr1(1) = .SelectedItems(1) & ''End IfEnd IfEnd Withi = 1k = 1Do While i < k Or i = k'查找文件或文件夹路径返回到ff = Dir(arr1(i), vbDirectory)On Error Resume Next  'vbDirectory找出无拓展名的文件，导致遍历遇到无拓展名文件会报错，所以要加上这句忽略报错Do'vbDirectory返回的值有文件路径，所以要判断返回的路径是否为文件的（文件格式会带'.',如'.xls')，和路径是否为空If InStr(f, '.') = 0 And f <> '' Thenk = k + 1arr1(k) = arr1(i) & f & ''End Iff = DirLoop Until f = ''i = i + 1Loop'*******下面是提取各个文件夹的文件***For x = 1 To kIf arr1(x) = '' Then Exit For'查找所有文件夹下的文件路径，并用循环记入arr2f3 = Dir(arr1(x) & '*.*')Do While f3 <> ''q = q + 1arr2(q, 1) = arr1(x) & f3f3 = DirLoopNext xActiveSheet.UsedRange = ''Range('A1').Resize(q) = arr2End Sub

4. 实例(改进)

获取路径下所有的文件及返回以下相关文件属性。

代码和上面相似，但关于如何返回文件属性，这里涉及到FileSystemObject属性和GetFile方法。

FileSystemObject 提供对计算机文件系统的访问权限。

它涉及到很多对象，之前学的GetOpenFilename、GetSaveAsFilename和FileDialog都是它的对象之一。太多对象了，这边不展开，想了解的可以点击以下链接：

FileSystemObject 对象docs.microsoft.com

这里要用到的是GetFile，返回与指定路径中的文件对应的对象。

语法：对象 . GetFile(文件路径)

FileSystemObject属性和GetFile方法组合使用如下示例：

  1. Dim fso As Object, myfile As Object
  2. Set fso = CreateObject('Scripting.FileSystemObject')
  3. Set myfile = fso.GetFile('C:')

实例完整代码：

Sub 提取文件信息()Dim arr(1 To 10000) As StringDim f, i, k, F2, f3, xDim arr1(1 To 100000, 1 To 6) As String, q As Integer  '6列放置文件夹的名称，大小，修改日期Dim fso As Object, myfile As ObjectDim dig As ObjectSet dig = Application.FileDialog(msoFileDialogFolderPicker)With dig.Title = '请选择需要查找的文件夹''如果沒选择文件夹路径退出程序，选择了就返回文件地址到arr(1)If .Show = 0 ThenExit SubElse'如果选择的是驱动盘，如D:，那就不需要在后面加''If VBA.Right(.SelectedItems(1),1) = '' Then   arr1(1) = .SelectedItems(1)Elsearr1(1) = .SelectedItems(1) & ''End IfEnd IfEnd Withi = 1k = 1Do While i < k Or i = kIf arr(i) = '' Then Exit Dof = Dir(arr(i), vbDirectory)On Error Resume Next  'vbDirectory找出无拓展名的文件，导致遍历遇到无拓展名文件会报错，所以要加上这句忽略报错DoIf InStr(f, '.') = 0 And f <> '' Thenk = k + 1arr(k) = arr(i) & f & ''End Iff = DirLoop Until f = ''i = i + 1Loop'*******下面是提取各个文件夹的文件***Set fso = CreateObject('Scripting.FileSystemObject')For x = 1 To UBound(arr)If arr(x) = '' Then Exit Forf3 = Dir(arr(x) & '*.*')Do While f3 <> ''q = q + 1arr1(q, 6) = arr(x) & f3               '第六列放文件路径Set myfile = fso.GetFile(arr1(q, 6))   '获取文件对象，以便后面查询返回文件属性arr1(q, 1) = f3                        '第一列放文件名称arr1(q, 2) = myfile.Size & '字节'      '第二列放文件大小，单位为字节arr1(q, 3) = myfile.DateCreated        '第三列放文件创建日期arr1(q, 4) = myfile.DateLastModified   '第四列放文件最新修改日期arr1(q, 5) = myfile.DateLastAccessed   '第五列放文件最近访问日期f3 = DirLoopNext xRange('a2').Resize(1000, 6) = ''  '清空单元格内容Range('a2').Resize(q, 6) = arr1   '把arr1的数组输出到单元格里End Sub
运行结果展示

这篇笔记有用到以往学的知识点，比如FileDialog、文件属性等等，都忘得差不多了，不停地查笔记和百度才写完了，得多学多用才不会忘。谢谢评论区的刘火火童鞋，修改了两个bug，不能查找驱动盘和无拓展名文件的问题。

赞 (0)

相关推荐