标题:如何自动将d盘中所有excel工作簿的路径写入到ListBox中
只看楼主
我叫好学
Rank: 1
等 级:新手上路
帖 子:4
专家分:0
注 册:2019-10-17
结帖率:0
已结贴  问题点数:20 回复次数:2 
如何自动将d盘中所有excel工作簿的路径写入到ListBox中
请教各位大神,如何自动将d盘中所有excel工作簿的路径写入到ListBox中
搜索更多相关主题的帖子: 写入 路径 ListBox excel 工作 
2019-10-17 21:47
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4912
专家分:29900
注 册:2008-10-15
得分:20 
有三种方案:
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

授人于鱼,不如授人于渔
早已停用QQ了
2019-10-18 11:00
我叫好学
Rank: 1
等 级:新手上路
帖 子:4
专家分:0
注 册:2019-10-17
得分:0 
回复 2楼 风吹过b
跪服大神,感谢感谢
2019-10-18 12:44



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-497325-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.207236 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved