递归法--遍历文件夹下的所有文件
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
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
