如何自动将d盘中所有excel工作簿的路径写入到ListBox中
请教各位大神，如何自动将d盘中所有excel工作簿的路径写入到ListBox中
1、使用控件，使用DIRlistbox控件 和 filelistbox 控件。
2、使用 dir 命令 。
3、使用 FSO 对象。
从代码量来讲，使用控件的代码量很小。
从效率来讲，我感觉使用 dir 命令 和 FSO 对象的效率 会更高一点。消息传递是需要消耗时间的。
使用控件，我D盘用时 4.5秒，使用 dir 命令,用时3.5秒。
下面是使用控件的代码：
程序代码：Private Sub Command1_Click()
File1.Pattern = "*.xls;*.xlsx" '文件名过滤器，在这个处理设置，或者在初始化之前设置
List1.Clear '调用前，先清原来的数据
Call 递归目录("D:\") '调用，要传一个初始路径进去，可以不为根目录
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path '当目录路径改变时，修改文件框路径
End Sub
Public Sub 递归目录(p As String)
Dim i As Long '循环变量
Dim j As Long '当前子目录数 ,0-j
Dim s() As String '缓存子目录名
Dir1.Path = p
j = Dir1.ListCount - 1 '子目录数
If j >= 0 Then '有子目录，则继续递归调用
ReDim s(Dir1.ListCount - 1)
For i = 0 To j '先缓存目录名，因为是重复使用这个控件
s(i) = Dir1.List(i)
Next i
For i = 0 To j '使用缓存的内容来递归调用
Call 递归目录(s(i))
Next i
End If
End Sub
Private Sub File1_PathChange()
'路径改变后会自动刷新文件列表，到这里处理
Dim i As Long
Dim p As String
p = File1.Path
If Right(p, 1) <> "\" Then p = p & "\" '确保路径结尾正确
For i = 0 To File1.ListCount - 1
List1.AddItem p & File1.List(i) '添加到列表中
Next i
End Sub
下面是使用 DIR 命令的代码
程序代码：
Private Sub Command2_Click()
List1.Clear '调用前，先清原来的数据
Call 递归目录2("D:\","*.xls;*.xlsx") '调用，要传一个初始路径进去，可以不为根目录
End Sub
Public Sub 递归目录2(P As String, Pattern As String)
On Error Resume Next
Dim i As Long, j As Long
Dim s() As String
Dim s1 As String
Dim s2() As String
If Right(P, 1) <> "\" Then P = P & "\"
'缓存目录
j = 0
s1 = Dir(P, vbDirectory)
Do While s1 <> ""
If s1 <> "." And s1 <> ".." Then
If (GetAttr(P & s1) And vbDirectory) = vbDirectory Then
j = j + 1
ReDim Preserve s(j)
s(j) = P & s1
End If
End If
s1 = Dir()
Loop
s2 = Split(Pattern, ";")
For i = 0 To UBound(s2)
Call 递归目录2列文件(P, s2(i)) 'DIR函数每个文件后缀需要单独使用，这个不方便。
Next i
For i = 1 To j '递归调用自己，遍类目录
Call 递归目录2(s(i), Pattern)
Next i
End Sub
Public Sub 递归目录2列文件(P As String, f As String)
Dim s1 As String
s1 = Dir(P & f)
Do While s1 <> ""
List1.AddItem P & s1
s1 = Dir()
Loop
End Sub
