vb获取文件夹下所有文件名_如何列举一个文件夹目录下所有文件详情的问题探讨...

关于这个问题，有着很强的现实意义：有效地挖掘、展示和收集一个给定目录(文件夹)下隶属的所有文件资源详情，而且无论给定的目录下不管有多少子目录，也不管子目录的深度如何，都将所有的隶属文件资源详情挖掘整理出来。

也许，大家看到过很多网友分享过这些类似的知识技术，但是给人的感觉都是给定的文件夹目录要么手工输入目录要么直接给定目录路径。显然，比较费时，能否通过自主获取当前目录文件夹的形式灵活知晓目录路径操作呢？答案肯定是可以的，这样不仅起到省时省心的作用，大大提高了定位目录文件夹的效率。

再者，自主获取的目录情况下(包含其所有的子目录)，如何获取其隶属的所有文件详细列表信息呢？这倒是一个关键技术问题，我之前的头条作品中，好像用过文件访问机制的.Subfolders和.Files的形式层级访问解决的款，有兴趣的朋友可以去看看。今天，我们就用一个简单明了的目录访问函数Dir()+循环语句Do……Loop的另一种形式来实现吧！

一、Excel中简单的界面设计

(一)前端界面设计

布局两个简单的交互按钮，如下图

图1 Excel前端界面

(二)VBA后台交互窗体界面设计

在窗体上主要添加了一个标签控件、一个框架控件及其内部的两个单选钮、一个命令按钮，如下图

图2 VBA后台交互窗体界面

二、功能代码及必要的注释

(一)VBA后台交互窗体内部的VBA代码：

Private Sub UserForm_Initialize()

Sel_Index = 0

FormClosed_flag = False

Label1.Caption = "当前的目录路径“" & ThisWorkbook.Path & "”"

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

Label1.Caption = "Label1"

Cancel = 0

FormClosed_flag = True

End Sub

Private Sub OptionButton1_Click()

Sel_Index = 1

End Sub

Private Sub OptionButton2_Click()

Sel_Index = 2

End Sub

Private Sub Cconfirm_Btn_Click()

Unload Disp_Kind_Of_File

FormClosed_flag = False

End Sub

(二)模块1中的代码如下：

Public Sel_Index, FormClosed_flag As Boolean '定义公有的全局要显示的文件类型变量，据此可以根据以哪种文件类型方式显示，FormClosed_flag为是否卸载关闭窗体的状态标志

Sub Generate_Folders_Display_In_Worksheet() '在工作表中生成指定的目录下所有文件列表信息数据展示

Dim sFolderPath As String

sFolderPath = ThisWorkbook.Path

Disp_Kind_Of_File.Show

'以下代码是选择显示的文件类型前清理原有的数据：有数据则清理，否则不用清理

max_row = [A65535].End(xlUp).Row

If max_row > 1 Then '“max_row>1”表示有数据，则作如下清理

Range("a2:a" & max_row).ClearContents

End If

If FormClosed_flag = True Then

MsgBox "你取消了显示文件列表信息详情的操作！", vbInformation, "提示"

Else

Select Case Sel_Index '根据选择的文件类型值Sel_Index进行分支判断处理

Case 1: GetExcelFile sFolderPath '调用显示所有Excel类型文件列表信息数据

Case 2: GetAllFile_Vertical_Display sFolderPath '调用显示所有类型文件列表信息数据

Case 0: MsgBox "什么类型也没选择，建议重新选择！", vbInformation, "提示"

End Select

End If

End Sub

Sub Erse_Datas() '删除工作表中已经加载的数据操作

Dim rg As Range

With Sheets("Sheet1")

max_row = .[A65535].End(xlUp).Row

If max_row < 2 Then

MsgBox "无数据了，禁止再次删除操作！", vbInformation, "提示"

Else

Set rg = .Range("A2:C" & max_row)

rg.ClearContents

Set rg = Nothing '让rg指派为Nothing意思是回收内存资源

MsgBox "删除数据成功！", vbInformation, "提示"

End If

End With

End Sub

'-------------------------------------------

'获取某文件夹下的所有Excel文件(不含子目录文件夹)

'-------------------------------------------

Sub GetExcelFile(sFolderPath As String)

On Error Resume Next

Dim f As String

Dim file() As String

Dim x

x = 2 '从第2行开始加载数据

ReDim file(1)

file(1) = sFolderPath & ""

f = Dir(file(1) & "*.xls") '通配符“*.*”表示所有文件，“*.xls”表示可以搜索到“*.xls、*.xlsx、*.xlsm”类型的Excel文件

Do Until f = ""

Range("a" & x) = f

Range("a" & x).Hyperlinks.Add Anchor:=Range("a" & x), Address:=file(1) & f, TextToDisplay:=f

x = x + 1

f = Dir

Loop

End Sub

'-----------------------------------------------------------------

'获取某文件夹下的所有文件和子目录下的文件，在Excel中以纵向方向展示

'-----------------------------------------------------------------

Sub GetAllFile_Vertical_Display(sFolderPath As String)

On Error Resume Next

Dim f As String, ObjectFileName As String

Dim file() As String

Dim i, k, x

x = 2: i = 1: k = 1 '“x=2”从第2行开始加载数据

ReDim file(1 To i)

ObjectFileName = ThisWorkbook.Name

file(1) = sFolderPath & ""

'-- 获得所有子目录

Do Until i > k

f = Dir(file(i), vbDirectory)

Do Until f = ""

If InStr(f, ".") = 0 Then

k = k + 1

ReDim Preserve file(1 To k)

file(k) = file(i) & f & ""

End If

f = Dir

Loop

i = i + 1

Loop

'-- 获得所有子目录下的所有文件

For i = 1 To k

f = Dir(file(i) & "*.*") '通配符*.*表示所有文件，*.xlsx Excel文件

Do Until f = ""

If f <> ObjectFileName Then

Range("a" & x).Hyperlinks.Add Anchor:=Range("a" & x), Address:=file(i) & f, TextToDisplay:=f

x = x + 1

End If

f = Dir

Loop

Next

End Sub

三、运行测试

(一)点击按钮准备启动打开交互窗体对话框

图3 启动交互窗体对话框

(二)点击上面交互窗体对话框的标题栏的按钮，将取消操作

图4 取消所有操作(一)

图5 取消所有操作(二)

(三)在上面的窗体对话框中选定需要展示文件类型方式。如下图

图6 选定列举文件的类型方式

(四)选定文件类型方式后，点击开窗体对话框对话框按钮后程序运行。结果如下图所示

图7 程序运行结果

(五)点击前端工作表界面上的按钮，将清除在工作表中所有展示的目录下文件列表信息的数据操作

图8 清除在工作表中所有展示的目录下文件列表信息的数据

(六)如果再次点击按钮，将禁止清除空数据的操作

图9 禁止清除空数据

好了，我们今天就此给大家分享倒这里吧，希望能借助这个方法对大家的工作需要带来方便。

最后，仍然非常感谢大家长期以来对我的头条原创作品的关注(头条号：跟我学Office高级办公)、推广和点评哦！谢谢！