怎样将指定路径的最末一级文件夹的全路径名录入数组

weiyingde

怎样将指定路径的最末一级文件夹的全路径名录入数组？
假如根目录在H盘。数组中的每一相如：
arr(1)="H:\音视频\视频\电视剧"
……

as42065300

不知道是不是你想要的结果。

1. Sub FilPaht()
   
2. Dim my$, arr(), mypaths$
   
3. my = ThisWorkbook.PatH & "" & "视频" '我这里是指定的当前工作簿的路径。
   
4. mypaths = Dir(my, vbDirectory)
   
5. Do While mypaths <> ""
   
6.     If mypaths <> "." And mypaths <> ".." Then
   
7.         n = n + 1
   
8.      ReDim Preserve arr(1 To n)
   
9.        arr(n) = my & mypaths
   
10.     End If
    
11.     mypaths = Dir
    
12. Loop
    
13. End Sub

复制代码

weiyingde

谢谢你答复，思路是对的，但只能到第二级目录，如下：
H:\音视频\视频
H:\音视频\音频

lsc900707

weiyingde 发表于 2016-9-9 19:32
谢谢你答复，思路是对的，但只能到第二级目录，如下：
H:\音视频\视频
H:\音视频\音频

可参考：
超好用的遍历文件夹及子文件夹,返回文件列表数组,可搜索文件类型,傻瓜版通用VBA函数
http://club.excelhome.net/thread-1116913-1-1.html
(出处: ExcelHome技术论坛)

音视频
	视频
		小品
		电影
		电视剧
		诗歌
		郑云微电影
	音频
		佛音
		手机铃声
		流行曲
		自备音效
		课间钟声
		轻音乐
		颁奖曲

weiyingde

as42065300 发表于 2016-9-9 19:02
不知道是不是你想要的结果。

在“音视频”文件夹里面最末一级的文件夹一共有12个应该是：
arr(1)="H:\音视频\视频\电视剧"
arr(2)="H:\音视频\视频\电影"
arr(3)="H:\音视频\视频\诗歌"
arr(4)="H:\音视频\视频\小品"
arr(5)="H:\音视频\视频\郑云微电影"
arr(6)="H:\音视频\音频\颁奖曲"
arr(7)="H:\音视频\音频\佛音"
arr(8)="H:\音视频\音频\课间钟声"
arr(9)="H:\音视频\音频\流行曲"
arr(10)="H:\音视频\音频\轻音乐"
arr(11)="H:\音视频\音频\手机铃声"
arr(12)="H:\音视频\音频\自备音效"
arr(12)="H:\音视频\音频\"
而在下的代码只列出视频文件夹里的子目录，音频里的子目录一个也没有。

weiyingde

sorry
这一个不是：arr(12)="H:\音视频\音频\"
笔误。

weiyingde

Sub FilPaht()
Dim my$, arr(), mypaths$
my = "H:\音视频\" '我这里是指定的当前工作簿的路径。
mypaths = Dir(my, vbDirectory)
Do While mypaths <> ""
    If mypaths <> "." And mypaths <> ".." Then
        n = n + 1
     ReDim Preserve arr(1 To n)
       arr(n) = my & mypaths
    End If
    mypaths = Dir
Loop
s = UBound(arr)
For i = 1 To s
Debug.Print arr(i)
Next
End Sub

as42065300

套个循环就可以了。没理解你的意思

1. Sub FilPaht()
   
2. Dim my$, arr(), mypaths$
   
3. ReDim arr(0)
   
4. my = ThisWorkbook.PatH & ""  '我这里是指定的当前工作簿的路径。
   
5. arr(0) = my
   
6. i = 0
   
7. Do While i <= UBound(arr)
   
8.     mypaths = Dir(arr(i), vbDirectory)
   
9.     Do While mypaths <> ""
   
10.         If mypaths <> "." And mypaths <> ".." And mypaths <> ThisWorkbook.Name Then
    
11.             n = n + 1
    
12.          ReDim Preserve arr(0 To n)
    
13.            arr(n) = arr(i) & mypaths & ""
    
14.         End If
    
15.         mypaths = Dir
    
16.     Loop
    
17.     i = i + 1
    
18. Loop
    
19. End Sub
    

复制代码

duquancai

1. Sub shishi()
   
2.     Dim arr(1 To 10000) As String, i&, k&
   
3.     arr(1) = "H:\音视频\视频\电视剧" '请指定路径
   
4.     i = 1: k = 1
   
5.     Do While i <= k
   
6.         If arr(i) = "" Then Exit Do
   
7.         f = Dir(arr(i), vbDirectory)
   
8.         Do
   
9.             If InStr(f, ".") = 0 And f <> "" Then
   
10.                 k = k + 1
    
11.                 arr(k) = arr(i) & f & ""
    
12.             End If
    
13.             f = Dir
    
14.         Loop Until f = ""
    
15.         i = i + 1
    
16.     Loop
    
17. End Sub

复制代码

as42065300

weiyingde 发表于 2016-9-9 19:56
Sub FilPaht()
Dim my$, arr(), mypaths$
my = "H:\音视频\" '我这里是指定的当前工作簿的路径。

笔误
arr(n) = arr(i) & mypaths & "\"
其实香川老是介绍的FileSystemObject对象也不错.