Option Explicit
'以竖式遍历先遍历某子目录及内部所有子目录，然后再返回与之同级的目录
Sub GetPath(ByVal FilePath As String,ByVal list As ListBox)
 
 '获取文件路径
 FilePath = IIf(Right(FilePath,1) = "\",FilePath,FilePath & "\")
 '获取当前目录内的文件名
 Dim FileName As String
 FileName = Dir(FilePath) '初次使用dir函数需指明路径
 
 '使用一个循环，遍历当前目录内的文件，并逐一验证其属性
 Do While FileName <> ""
 If Right(FileName,3) = "jpg" Then
 list1.AddItem FilePath & "\" & FileName
 End If
 
 FileName = Dir
 Loop
 
 '缺少此句只会遍历一级目录
 FileName = LCase(Dir(FilePath,vbDirectory))
 
 Dim ChildContent() As String
 Dim Count As Integer
 '获取下一级目录
 Do While FileName <> ""
 If FileName <> "." And FileName <> ".." Then
 If GetAttr(FilePath & FileName) And vbDirectory Then
 Count = Count + 1
 ReDim Preserve ChildContent(Count)
 '将下一级目录放入动态数组
 ChildContent(Count) = FilePath & "\" & FileName
 End If
 End If
 
 FileName = Dir
 DoEvents
 
 Loop
 
 '回调自身,获取下一级目录内文件路径
 Dim i As Integer
 For i = 1 To Count
 GetPath ChildContent(i),list
 Next i
 
End Sub

Private Sub cmdGetPath_Click()
 GetPath App.Path,list1
End Sub