递归法--遍历文件夹下的所有文件

0 Reply , Posted in 程序代码 on 2017 28, 2017

Option Explicit
Private Const LB_SETHORIZONTALEXTENT = &H194
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

  Private Sub Command1_Click()
          Dim ff    As String
          Dim fn     As Long
          Dim i     As Long
          Dim Fpath As String
          Dim obj As Object
        
          For Each obj In Me '.Frame1
            If TypeOf obj Is CheckBox Then
                 'obj.Value = True
                If obj.Value = 1 Then
                     Fpath = Left(obj.Caption, 1) & ":"
                    ' MsgBox Fpath
                      Call FindAllFolder(Fpath)
                End If
            End If
          Next
         
         ' Fpath = Text1.Text
         ' If Len(Fpath) = 1 Then Fpath = Fpath & ":"
        
  End Sub
   
  Private Function FindAllFolder(ByVal FilePath As String)
          Dim lngIndex      As Long
          Dim strDir        As String
          Dim strSubDirs()  As String
          Dim sFiles As String
          If Right(FilePath, 1) <> "\" Then ''''追加路径
                  FilePath = FilePath & "\"
          End If
           
          strDir = Dir(FilePath & "*.*") '''获得当前的路径
         
          Do While Len(strDir) '''''遍历当前文件夹的文件
              DoEvents
           
              sFiles = FilePath & strDir
              List1.AddItem sFiles
              strDir = Dir
          Loop
           
          lngIndex = 0
          strDir = Dir(FilePath & "*.*", 16)
          Do While Len(strDir)
            DoEvents
             If Left(strDir, 1) <> "." Then
                If GetAttr(FilePath & strDir) And vbDirectory Then
                    lngIndex = lngIndex + 1
                    ReDim Preserve strSubDirs(1 To lngIndex)
                    strSubDirs(lngIndex) = FilePath & strDir & "\"
                End If
             End If
             strDir = Dir  '''''文件夹下的所有文件 dir("")
          Loop
           
          For lngIndex = 1 To lngIndex
                DoEvents
                Call FindAllFolder(strSubDirs(lngIndex)) '''递归调用
          Next lngIndex
  End Function
Private Sub Form_Load()
    SendMessage List1.hwnd, LB_SETHORIZONTALEXTENT, 500, 0 '''''list1 添加水平滚动条!
End Sub

标签:    

相关推荐

vb读取access并且显示  (2017-5-11 9:18:27)

VB 获取CPU温度示例  (2017-5-8 10:35:11)

VB程序逆向反汇编常见的函数   (2017-5-8 10:32:0)

VB内嵌汇编的模块示例  (2017-5-8 10:24:4)

内存数据的读写(PC)   (2017-3-1 17:51:40)

用VB制作外挂   (2017-3-1 16:16:53)

发表评论:



◎欢迎参与讨论,请在这里发表您的看法、交流您的观点。

                       

  鄂公网安备 42112502000156号     鄂ICP备16019550号