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

假设用Str1表示某个本地文件夹,其下有n个子文件夹,每个子文件夹又有若干个文件,怎样用ExcelVBA列出文件夹及文件名。假设定义一个数组Str(m,n),当n=0时,... 假设用Str1表示某个本地文件夹,其下有n个子文件夹,每个子文件夹又有若干个文件,怎样用Excel VBA列出文件夹及文件名。假设定义一个数组Str(m,n),当n=0时,该变量表示文件夹名,当n≠0,表示该文件夹下第n个文件名。 展开
 我来答
ExcelPower
推荐于2016-01-05 · 专业Excel公式图表数据分析VBA
ExcelPower
采纳数:4495 获赞数:11863

向TA提问 私信TA
展开全部

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

在文件夹内 新建 个 Excel文件  

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

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

效果如图:


 

匿名用户
2013-06-20
展开全部
'新建一个模块,复制以下代码进去 '动态创建工具栏控件,运行CreateToolBar过程看一下主界面的工具条
Sub CreateToolBar()
With Application.CommandBars.Add(Name:="文件管理", Position:=msoBarTop, temporary:=True)
.Visible = True
With .Controls.Add(Type:=msoControlPopup, temporary:=True)
.Caption = "目录列表 C:\"
.TooltipText = "C:\"
.OnAction = "CreateChildFolder"
End With
With .Controls.Add(Type:=msoControlPopup, temporary:=True)
.Caption = "目录列表 D:\"
.TooltipText = "D:\"
.OnAction = "CreateChildFolder"
End With
With .Controls.Add(Type:=msoControlPopup, temporary:=True)
.Caption = "目录列表 E:\"
.TooltipText = "E:\"
.OnAction = "CreateChildFolder"
End With
With .Controls.Add(Type:=msoControlPopup, temporary:=True)
.Caption = "目录列表 F:\"
.TooltipText = "F:\"
.OnAction = "CreateChildFolder"
End With
End With
End SubPrivate Sub CreateChild(Parent As Office.CommandBarPopup, FolderPath As String)
Dim iFolder As String, iFile As String, Ctl As CommandBarControl
If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
For Each Ctl In Parent.Controls
Ctl.Delete
Next
With Parent.Controls
iFolder = Dir(FolderPath, vbDirectory)
Do While iFolder <> ""
If iFolder <> "." And iFolder <> ".." Then
If (GetAttr(FolderPath & iFolder) And vbDirectory) = vbDirectory Then
With .Add(Type:=msoControlPopup, temporary:=True)
.Caption = iFolder
.TooltipText = FolderPath & iFolder
.OnAction = "CreateChildFolder"
End With
End If
End If
iFolder = Dir
Loop
iFile = Dir(FolderPath & "\*.*")
Do While iFile <> ""
With .Add(Type:=msoControlButton, temporary:=True)
.Caption = iFile
.TooltipText = FolderPath & "\" & iFile
.OnAction = "OpenFile"
End With
iFile = Dir
Loop
End With
End SubPrivate Sub CreateChildFolder()
Dim MyPopup As Office.CommandBarPopup
Set MyPopup = Application.CommandBars.ActionControl
Call CreateChild(MyPopup, MyPopup.TooltipText)
End SubPrivate Sub OpenFile()
ActiveWorkbook.FollowHyperlink CommandBars.ActionControl.TooltipText
End Sub
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
匿名用户
2013-06-20
展开全部
Sub xxx()

Dim Str1 As String, tMp As String
Dim xStr(0 To 99, 0 To 99) As String
Dim i, j, k As Integer
Str1 = "D:\Test"
ChDrive Left(Str1, 1)
ChDir Str1
tMp = Dir$("", 16)
i = 0
Do Until Len(tMp) = 0
If InStr(tMp, ".") = 0 Then
xStr(i, 0) = tMp
i = i + 1
End If
tMp = Dir$
Loop

For k = 0 To i - 1
ChDir Str1 & "\" & xStr(k, 0)
j = 1
tMp = Dir$("")
Do Until Len(tMp) = 0
xStr(k, j) = tMp
j = j + 1
tMp = Dir$
Loop
Next k

End Sub

验证无误。
本回答被网友采纳
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
收起 更多回答(1)
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式