| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1676 人关注过本帖
标题:关于遍历目录的问题
只看楼主 加入收藏
renxiaoyao36
Rank: 9Rank: 9Rank: 9
来 自:七宝中学
等 级:贵宾
威 望:31
帖 子:347
专家分:1077
注 册:2014-9-18
结帖率:92.31%
收藏
已结贴  问题点数:20 回复次数:14 
关于遍历目录的问题
如何写一个函数,遍历一个上级目录下的文件及其子目录内的所有EXE文件,包括2级目录,3级目录,等等
我网上找到的是一个SUB,我不大会改,应为它似乎只输出一次且是Listbox格式输出,我的需求是每次找到新的文件后,将这个文件的完整路径(注意是完整路径),输出到一个文件中。而且要跳过一个特定的子目录。
在此声明,我不是伸手党,只是应为我现在学习的东西光靠源代码不能理解了,所以在此请求各位帮助我一下,谢谢啦
先放一下我学习时找到的代码
程序代码:
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
搜索更多相关主题的帖子: 源代码 而且 如何 网上 
2015-04-29 20:09
linandceline
Rank: 2
等 级:论坛游民
威 望:2
帖 子:88
专家分:47
注 册:2014-12-19
收藏
得分:3 
我是写在模块里的
Public Sub cNewfile(Mypath As String)
Dim Myname, Filelenm As String
Dim Dirnum() As String
Dim m, n, idir As Long

If Right(Mypath, 1) <> "\" Then Mypath = Mypath + "\"
Myname = Dir(Mypath, vbDirectory Or vbNormal Or vbReadOnly)

Do While Myname <> ""
  If Myname <> "." And Myname <> ".." Then
    If (GetAttr(Mypath & Myname) And vbDirectory) = vbDirectory Then '如果找到的是目录
      idir = idir + 1
      ReDim Preserve Dirnum(idir) As String
      Dirnum(idir - 1) = Myname
    Else
      Form1.List5.AddItem TrimPath(Mypath & Myname)  '把找到的文件名显示到form1.list5
      Form1.List3.AddItem FileDateTime(Mypath & Myname) '把找到的文件时间显示到form1.list3
      Form1.List4.AddItem Mypath & Myname '把文件路径显示到form1.list4
    End If
  End If
  Myname = Dir '搜索下一项
Loop

For i = 0 To idir - 1
  Call Cdir(Mypath + Dirnum(i)) '在子目录中搜索
Next
ReDim Dirnum(0) As String

Form1.List1.Clear '保留文件代码
For m = 0 To (Form1.List5.ListCount - 1)
  If InStr(Form1.List5.List(m), " ") > 0 Then
    n = Len(Left(Form1.List5.List(m), InStr(Form1.List5.List(m), " ")))
    Form1.List1.AddItem Left(Form1.List5.List(m), n - 1)
  End If
Next

Form1.List2.Clear
For i = 0 To Form1.List5.ListCount - 1   '保留除文件代码之外的内容,并删掉第一个空格
  Filelenm = Right(Form1.List5.List(i), Len(Form1.List5.List(i)) - InStr(Form1.List5.List(i), " "))
  Do While InStr(Filelenm, " ") = 1
    Filelenm = Right(Filelenm, Len(Filelenm) - 1)
  Loop
  Form1.List2.AddItem Filelenm
Next
End Sub

Public Sub Cdir(Mypath As String)
Dim Myname, MyPath3, Mypath4 As String
Dim Dirnum(1 To 90000) As String
Dim m, n As Long
Dim idir As Long

MyPath3 = Mypath
Do While InStr(MyPath3, "\") > 0
  i = Len(MyPath3)
  j = InStr(MyPath3, "\")
  MyPath3 = Right(MyPath3, (i - j))
Loop
Form1.List5.AddItem MyPath3 '将文件夹名加入list3

If Right(Mypath, 1) <> "\" Then Mypath = Mypath + "\"
Form1.List4.AddItem Mypath '将路径名加入list5
Myname = Dir(Mypath, vbNormal Or vbReadOnly)

Do While Myname <> ""
  If Myname <> "." And Myname <> ".." Then
     idir = idir + 1
     Dirnum(idir) = FileDateTime(Mypath & Myname)
  End If
  Myname = Dir '搜索下一项
Loop

If idir > 0 Then '比较出最近的文件修改时间来作为文件夹的修改时间
  If idir = 1 Then
    Dirtime = Dirnum(1)
  Else
    For j = 1 To idir - 1
      If Dirnum(j) > Dirnum(j + 1) Then
        Dirtime = Dirnum(j)
      Else
        Dirtime = Dirnum(j + 1)
      End If
    Next
  End If
End If
If Dirtime <> "" Then
  Form1.List3.AddItem Dirtime
End If
End Sub

Public Function TrimPath(sPath As String) As String '获取不带扩展名的文件名称
    Dim i As Integer, j As Integer
    i = InStrRev(sPath, "\") + 1
    j = InStrRev(sPath, ".")
    TrimPath = Mid(sPath, i, j - i)
End Function

[ 本帖最后由 linandceline 于 2015-4-30 08:40 编辑 ]
2015-04-30 08:39
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:17 
程序代码:
Private Sub Command1_Click()
Call listfils("G:\TDDOWNLOAD")          '调用示例,参数为目录名,目录不强求以 \ 结束
End Sub

Public Sub listfils(cs As String)

On Error Resume Next                '忽略错误的文件名用

Dim s As String
Dim m As String
Dim fj() As String
Dim p As String
Dim i As Long

If Right(cs, 1) = "\" Then          '确保路径格式正确
    p = cs
Else
    p = cs & "\"
End If
    
m = ""                              'm 保存目录名

s = Dir(p, vbDirectory)             '取目录名

Do While Len(s) > 0                 '取到内容继续
   If s <> "." And s <> ".." Then   '非本级及上一级
      If (GetAttr(p & s) And vbDirectory) = vbDirectory Then        '再判断一下是不是目录
         m = m & "*" & p & s        '先保存起来,如果直接递归,会造成 DIR 参数冲突
      End If
   End If
s = Dir                             '取下一个目录
Loop

s = Dir(p & "*.exe")                '取目标文件名
Do While Len(s) > 0                 '取到内容继续
    Text1.Text = Text1.Text & p & s & vbCrLf        '显示取的内容
    s = Dir                         '取下一个
Loop

fj = Split(m, "*")                  '把取到的目录名分解为数组

For i = 1 To UBound(fj)             '第一个元素(下标0)必须为空,与连接的方式有关
    Call listfils(fj(i))            '调用本身列出子目录的内容来
Next

End Sub


如果你要跳过指定目录,那么这句前面再判断一下。
         m = m & "*" & p & s        '先保存起来,如果直接递归,会造成 DIR 参数冲突

只要不把 这个目录加入到列表就会自动跳过。

这个程序写成 递归是最好写的。

你要写成循环的话,那就需要一个动态数组或listbox 来保存中间数据,并且每次都使用中间数据来读后面的数据。

授人于鱼,不如授人于渔
早已停用QQ了
2015-04-30 11:58
renxiaoyao36
Rank: 9Rank: 9Rank: 9
来 自:七宝中学
等 级:贵宾
威 望:31
帖 子:347
专家分:1077
注 册:2014-9-18
收藏
得分:0 
是不是加上
If m<>"指定目录" then  m = m & "*" & p & s

递归不大会,看到有个M的注释说是存储的目录,这样子改可行么?

编程蛋疼的不是枯燥,而是辛辛苦苦编完几百行的代码,运行,“Runtime Error “xxx””。
2015-04-30 17:31
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
应该是
If s<>"指定目录" then  m = m & "*" & p & s

m是用来暂存所有的子目录,s 是刚取到的。不愿使用动态数组做,那个代码更烦,所以就只用一个字符串来保存。

授人于鱼,不如授人于渔
早已停用QQ了
2015-05-01 01:01
renxiaoyao36
Rank: 9Rank: 9Rank: 9
来 自:七宝中学
等 级:贵宾
威 望:31
帖 子:347
专家分:1077
注 册:2014-9-18
收藏
得分:0 
谢谢,受教了
我去试一下
另外,输出的完整文件路径是不是Text1.Text?这样改动是否可以达成输出文件路径的要求
Text1.Text = Text1.Text & p & s & vbCrLf        '显示取的内容

改成
open (app.path & "\cptemp\" & Tag1 & ".tmp") for output as #1
Print #1,(p & s)
close #1

在论坛打字的,没有在VB编译环境里试过,有点难以看懂,抱歉
Tag1是个计数变量,每次递归完成时值+1

编程蛋疼的不是枯燥,而是辛辛苦苦编完几百行的代码,运行,“Runtime Error “xxx””。
2015-05-01 09:04
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
没错。 p 是路径,s 是刚取到的目录名。
这样保存可以的。

递归,就是自己调用自己 。最有名的递归就是 汉诺塔 的程序,那个是典型的 递归。
还有,计算 阶乘,也可以用递归来写。

if n-1 then
   R=1
else
   R=n*R(n-1)
end if

如果 R(5)
1  5*R(4)
2  5*(4*R(3))
3  5*(4*(3*R(2))
4  5*(4*(3*(2*R(1))))
5  5*(4*(3*(2*(1))))

授人于鱼,不如授人于渔
早已停用QQ了
2015-05-01 11:13
renxiaoyao36
Rank: 9Rank: 9Rank: 9
来 自:七宝中学
等 级:贵宾
威 望:31
帖 子:347
专家分:1077
注 册:2014-9-18
收藏
得分:0 
以下是引用风吹过b在2015-5-1 11:13:19的发言:

没错。 p 是路径,s 是刚取到的目录名。
这样保存可以的。

递归,就是自己调用自己 。最有名的递归就是 汉诺塔 的程序,那个是典型的 递归。
还有,计算 阶乘,也可以用递归来写。

if n-1 then
   R=1
else
   R=n*R(n-1)
end if

如果 R(5)
1  5*R(4)
2  5*(4*R(3))
3  5*(4*(3*R(2))
4  5*(4*(3*(2*R(1))))
5  5*(4*(3*(2*(1))))

if n-1 then
这个IF语句感觉缺少了一些判断语句啊

编程蛋疼的不是枯燥,而是辛辛苦苦编完几百行的代码,运行,“Runtime Error “xxx””。
2015-05-01 11:29
renxiaoyao36
Rank: 9Rank: 9Rank: 9
来 自:七宝中学
等 级:贵宾
威 望:31
帖 子:347
专家分:1077
注 册:2014-9-18
收藏
得分:0 
不多说了,先给分
给完分风版主还是要回答一下我的疑惑啊

编程蛋疼的不是枯燥,而是辛辛苦苦编完几百行的代码,运行,“Runtime Error “xxx””。
2015-05-01 11:29
renxiaoyao36
Rank: 9Rank: 9Rank: 9
来 自:七宝中学
等 级:贵宾
威 望:31
帖 子:347
专家分:1077
注 册:2014-9-18
收藏
得分:0 
另外问一下
Do while是不是个循环?只要条件依旧符合,循环永不停止?
最近用Do while发现怎么都出不去,吧Do while的条件的值改一下就可以了,所以在此问一下

编程蛋疼的不是枯燥,而是辛辛苦苦编完几百行的代码,运行,“Runtime Error “xxx””。
2015-05-01 11:34
快速回复:关于遍历目录的问题
数据加载中...
 
   



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

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