如何用VBA读取一个文件夹内所有子文件夹的名称

为了汇总,有时我们要把统一个文件夹的所有子文件夹的名称,若是是少数几个可以复制粘贴,若是几十上百或者更多就麻烦了,今天小编和大师分享用VBA来读取文件名称或者读取文件夹内的EXCEL文件名称

东西/原料

  • EXCEL2013

提取文件夹名称

  1. 1

    先在F盘(也可以在其它的非系统盘)——右击——新建——文件夹——然后给文件夹定名为:读取文件夹

  2. 2

    新建一个空白的EXCEL文档——然后点击文件——保留——保留地址就选择方才成立的文件夹那边——然后给文件定名为:读取文件夹名称

  3. 3

    接着在EXCEL那边同时按alt+F11,打开宏编纂器,点击插入——模块,在模块那边输入如下代码(文件夹的地址可以在电脑地址栏那边复制):

    Sub 提取文件夹名称()

    Dim fs As Object

    n = 1

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set f = fs.getfolder("F:\读取文件夹")

    For Each fd In f.subfolders

    Cells(n, 1) = fd.Name

    n = n + 1

    Next

    Set f = Nothing

    Set fs = Nothing

    End Sub

  4. 4

    若是想经由过程VBA代码由本身选择文件夹再执行提取文件夹名称,可以在VBA编纂模块那边输入如下代码:

    Sub getFldList1()

        Dim Fso, Fld

        Dim Arr(1 To 999), k%

        Set Fso = CreateObject("Scripting.FileSystemObject")

        Set Fld = Fso.getfolder(CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件夹", 0, "").Self.Path & "")

        For Each fd In Fld.subfolders

            k = k + 1

            Arr(k) = fd.Name

        Next

        [A1].Resize(k) = Application.Transpose(Arr)

    End Sub

提取文件夹下的

  1. 1

    案例申明:此刻读取文件夹里有三个子文件夹,每个子文件夹都有EXCEL文档,此刻要把所有的本家儿文件夹和子文件夹下的EXCEL文件名提掏出来。

  2. 2

    接着点击视图——宏——查看宏(也可以直接按alt+F11)打开宏编纂器——点击插入模块,然后插入如下图的代码:

    Sub 遍历文件夹()

      'On Error Resume Next

      Dim fn(1 To 10000) As String

      Dim f, i, k, f2, f3, x

      Dim arr1(1 To 100000, 1 To 1) As String, q As Integer

      Dim t

      t = Timer

      fn(1) = ThisWorkbook.Path & "\"

      i = 1: k = 1

      Do While i < UBound(fn)

        If fn(i) = "" Then Exit Do

        f = Dir(fn(i), vbDirectory)

        Do

          If InStr(f, ".") = 0 And f <> "" Then

            k = k + 1

            fn(k) = fn(i) & f & "\"

          End If

          f = Dir

        Loop Until f = ""

        i = i + 1

      Loop

      '*******接下来是提取各个文件夹的文件***

      For x = 1 To UBound(fn)

          If fn(x) = "" Then Exit For

           f3 = Dir(fn(x) & "*.*")

         Do While f3 <> ""

           q = q + 1

           arr1(q, 1) = fn(x) & f3

           f3 = Dir

         Loop

      Next x

      ActiveSheet.UsedRange = ""

      Range("a1").Resize(q) = arr1

      MsgBox Format(Timer - t, "0.00000")

      End Sub

注重事项

  • 但愿能帮忙到你
  • 发表于 2019-02-09 20:00
  • 阅读 ( 3864 )
  • 分类:其他类型

你可能感兴趣的文章

相关问题

0 条评论

请先 登录 后评论
admin
admin

0 篇文章

作家榜 »

  1. xiaonan123 189 文章
  2. 汤依妹儿 97 文章
  3. luogf229 46 文章
  4. jy02406749 45 文章
  5. 小凡 34 文章
  6. Daisy萌 32 文章
  7. 我的QQ3117863681 24 文章
  8. 华志健 23 文章

推荐文章

联系我们:uytrv@hotmail.com 问答工具