为了汇总，有时我们要把统一个文件夹的所有子文件夹的名称，若是是少数几个可以复制粘贴，若是几十上百或者更多就麻烦了，今天小编和大师分享用VBA来读取文件名称或者读取文件夹内的EXCEL文件名称
工具/原料
- EXCEL2013
提取文件夹名称
- 1
先在F盘（也可以在其它的非系统盘）——右击——新建——文件夹——然后给文件夹定名为：读取文件夹
- 2
新建一个空白的EXCEL文档——然后点击文件——保留——保留地址就选择方才成立的文件夹那边——然后给文件定名为：读取文件夹名称
- 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
若是想经由过程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
案例申明：此刻读取文件夹里有三个子文件夹，每个子文件夹都有EXCEL文档，此刻要把所有的本家儿文件夹和子文件夹下的EXCEL文件名提掏出来。
- 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
注重事项
- 但愿能帮忙到你
