vba子文件夹文件名字

‘壹’ vba提取多层文件夹的*.xls文件,根据获取到的文件名及路径逐个打开*.xls文件,去判断某几列有多少个数据

• 一、所需DOS命令

  dir [drive:][path] /b > [drive:][path]filename

  二、应用实例

  如下图，在D盘中，有一个名称为“TQIPC”的文件夹，这个文件夹里面，存放了很多的照片！

  

• 看到了没有，文件夹中的照片名称，自动就显示在excel表格中了！

  该dos命令非常强大，用好dos命令，可省去我们很多的功夫。

  三、知识扩展

  下面，再给大家一个例子，即，自动根据照片(根据人物名称)，建立文件夹。

  如果某个文件夹下面，您存放的是某些人物的照片，并且，每个人物的照片，都使用其名字来命名；这个时候，如何要自动根据人物的自动建立其对应的文件夹，也相当方便！

  操作的方法是，先根据上述的方法，获取所有人物的照片的名称，生成EXCEL文件；

  然后，在人物名称列前面，插入一列，并输入MD；

  接下来，使用查找替换功能，将excel文件中的人物名称，去掉扩展名(只保留名字)；

  最后，将excel的内容，复制粘贴到记事本中，现在，我们就得到了形如：“MD人物名称”这样的命令格式了。(md 文件名称，该命令格式，是使用来建立文件夹的命令，上述的操作，都是为此做准备！)

  将记事本文件保存成为形如：124.bat格式的文件，最后，双击此文件，文件夹名称就自动建立好了！

‘贰’ vba 遍历指定文件夹（含子目录）获取文件名，哪种方法速度最快

Sub LoopAllExcelFilesInFolder()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'这里很关键，决定宏执行快慢的关键
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'打开目录选择框
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

With FldrPicker
.Title = "请选择目录"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With

'取消选择
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings

'指定过滤的文件后缀
myExtension = "*.xls*"

'遍历全路径
myFile = Dir(myPath & myExtension)

'循环处理每一个文件
Do While myFile <> ""
'打开
Set wb = Workbooks.Open(Filename:=myPath & myFile)

'确保工作簿被打开，在处理下一个文件时
DoEvents

'设置背景色
wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)

'保存工作簿
wb.Close SaveChanges:=True

'确保工作簿被关闭，在处理下一个文件时
DoEvents

'接着处理下一个
myFile = Dir
Loop

'提示处理完成
MsgBox "处理完成!"

ResetSettings:
'恢复设置
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

‘叁’ Excel VBA列出某文件夹下子文件夹及文件名

遍历文件夹 并列出文件 & 文件夹 名 代码如下：

在文件夹内 新建 个 Excel文件

Excel文件内 按 Alt+F11 视图--代码窗口， 把如下代码复制进去， F5运行

Sub遍历文件夹()
'OnErrorResumeNext
Dimfn(1To10000)AsString
Dimf,i,k,f2,f3,x
Dimarr1(1To100000,1To1)AsString,qAsInteger
Dimt
t=Timer
fn(1)=ThisWorkbook.path&""
i=1:k=1
DoWhilei<UBound(fn)
Iffn(i)=""ThenExitDo
f=Dir(fn(i),vbDirectory)
Do
IfInStr(f,".")=0Andf<>""Then
k=k+1
fn(k)=fn(i)&f&""
EndIf
f=Dir
LoopUntilf=""
i=i+1
Loop
'*******下面是提取各个文件夹的文件***
Forx=1ToUBound(fn)
Iffn(x)=""ThenExitFor
f3=Dir(fn(x)&"*.*")
DoWhilef3<>""
q=q+1
arr1(q,1)=fn(x)&f3
f3=Dir
Loop
Nextx
ActiveSheet.UsedRange=""
Range("a1").Resize(q)=arr1
MsgBoxFormat(Timer-t,"0.00000")
EndSub

效果如图：

‘肆’ 用VBA代码如何获得指定文件夹内的所有子文件夹名称

Set fso=CreateObject("Scripting.FileSystemObject")
Set folder=fso.GetFolder("D:")
dim a() as string
dim b
b=1
for each thing in folder.subfolders
addfolder fso,thing,a,b
next
msgbox b

function addfolder(byref fso,byref dir,byref a,byref b)
set folder=fso.getfolder(dir)
a(b)=dir
b=b+1
For Each thing in folder.SubFolders
set folder=fso.getfolder(thing)
a(b)=thing
b=b+1
addfolder fso,thing,a,b
Next
end function