为了汇总,有时我们要把统一个文件夹的所有子文件夹的名称,若是是少数几个可以复制粘贴,若是几十上百或者更多就麻烦了,今天小编和大师分享用VBA来读取文件名称或者读取文件夹内的EXCEL文件名称
先在F盘(也可以在其它的非系统盘)——右击——新建——文件夹——然后给文件夹定名为:读取文件夹
新建一个空白的EXCEL文档——然后点击文件——保留——保留地址就选择方才成立的文件夹那边——然后给文件定名为:读取文件夹名称
接着在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
若是想经由过程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
案例申明:此刻读取文件夹里有三个子文件夹,每个子文件夹都有EXCEL文档,此刻要把所有的本家儿文件夹和子文件夹下的EXCEL文件名提掏出来。
接着点击视图——宏——查看宏(也可以直接按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
0 篇文章
如果觉得我的文章对您有用,请随意打赏。你的支持将鼓励我继续创作!