如可实现递归遍历一目录下所有子目录及文件!!

时间:2021-06-10 14:28:56
请高手指教,如可实现递归遍历一目录下所有子目录及文件!!有源程序最好!!

6 个解决方案

#1


http://www.csdn.net/Expert/TopicView1.asp?id=798020
这里去看看,里面有我写的一个递归代码

#2


程序是我写的一个文件查找替换小工具软件源程序
有一次我们的IP地址的端口要改动,涉及到网站服务器上所有的页面文件,
将近有10G的文件

所以写了这个程序,如果手工去改的话,一天都改不完,而且还不能保证
没有遗露,用这个东西,半个小时完全搞定,得到领导的赏识,哈,开心的笑啦!

你所要的主要是下面这段代码,用递归的方法,来实现查找多级目录下的文件

自己看看吧,

Private Sub FindFile(Fd As Folder, FileName As String, StrSearch As String)
  Dim sFd As Folder, Fn As File
  Dim RTs As TextStream
  For Each Fn In Fd.Files    '查找当前目录所有文件
     StatusBar1.Panels(1).Text = "请稍候,正在搜索......"
     StatusBar1.Panels(2).Text = Fn.Path
    If (UCase(Fn.Name) Like UCase(FileName)) And Fn.Size > 0 Then
        Set RTs = Fs.OpenTextFile(Fn.Path, ForReading, False, False)
        If InStr(1, Trim(RTs.ReadAll), StrSearch, 1) > 0 Then
      With ListView1
            Index = Index + 1
           .ListItems.Add Index, , Fn.Name
           .ListItems(Index).SubItems(1) = Fn.Size
           .ListItems(Index).SubItems(2) = Fn.Path
           .ListItems(Index).SubItems(3) = Fn.Type
           .ListItems(Index).SubItems(4) = Fn.DateLastModified
      End With
        End If
        RTs.Close
        Set RTs = Nothing
   End If
   DoEvents
   Next
   
  For Each sFd In Fd.SubFolders    '循环查找所有子目录
      FindFile sFd, FileName, StrSearch
  Next
End Sub

#3


程序是我写的一个文件查找替换小工具软件源程序
有一次我们的IP地址的端口要改动,涉及到网站服务器上所有的页面文件,
将近有10G的文件

所以写了这个程序,如果手工去改的话,一天都改不完,而且还不能保证
没有遗露,用这个东西,半个小时完全搞定,得到领导的赏识,哈,开心的笑啦!

你所要的主要是下面这段代码,用递归的方法,来实现查找多级目录下的文件

自己看看吧,

Private Sub FindFile(Fd As Folder, FileName As String, StrSearch As String)
  Dim sFd As Folder, Fn As File
  Dim RTs As TextStream
  For Each Fn In Fd.Files    '查找当前目录所有文件
     StatusBar1.Panels(1).Text = "请稍候,正在搜索......"
     StatusBar1.Panels(2).Text = Fn.Path
    If (UCase(Fn.Name) Like UCase(FileName)) And Fn.Size > 0 Then
        Set RTs = Fs.OpenTextFile(Fn.Path, ForReading, False, False)
        If InStr(1, Trim(RTs.ReadAll), StrSearch, 1) > 0 Then
      With ListView1
            Index = Index + 1
           .ListItems.Add Index, , Fn.Name
           .ListItems(Index).SubItems(1) = Fn.Size
           .ListItems(Index).SubItems(2) = Fn.Path
           .ListItems(Index).SubItems(3) = Fn.Type
           .ListItems(Index).SubItems(4) = Fn.DateLastModified
      End With
        End If
        RTs.Close
        Set RTs = Nothing
   End If
   DoEvents
   Next
   
  For Each sFd In Fd.SubFolders    '循环查找所有子目录
      FindFile sFd, FileName, StrSearch
  Next
End Sub

#4


凭什么告诉你?

#5


如何在VB中实现目录遍历 
一、API 函 数 的 声 明、 自 定 义 数 据 类 型 及 常 量 的 定 义 
---- 注 意:API 函 数 的 声 明应 在 应 用 程 序 的 代 码 模 块 中 进 行, 且 一 条 声 明 必 须 放 在 一 行 中'API 函 数 的 声 明 
Public Declare Function FindFirstFile Lib
"kernel32" Alias "FindFirstFileA" 
(ByVal lpFileName As String, 
lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib
"kernel32" Alias "FindNextFileA" 
(ByVal hFindFile As Long, lpFindFileData
As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib
"kernel32" (ByVal hFindFile As Long) As Long

'最大路径长度和文件属性常量的定义
Public Const MAX_PATH = 260
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100

'自定义数据类型FILETIME和WIN32_FIND_DATA的定义
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

二、 去 掉 固 定 长 度 字 符 串 右 边 的NULL 字 符(ASCII 值 为0) 和SPACE 字符(ASCII 值 为32) 
---- 由 于 数 据 类 型WIN32_FIND_DATA 的cFileName 元 素 为 定 长 数据 类 型 且 在 执 行 函 数FindFirstFile 和FindNextFile 后 会 有NULL 字 符, 因 此 需 去 掉 其 中的 无 效 字 符。 
Public Function fDelInvaildChr
(str As String) As String
On Error Resume Next
For i = Len(str) To 1 Step -1
If Asc(Mid(str, i, 1)) < >
0 And Asc(Mid(str, i, 1)) <> 32 Then
fDelInvaildChr = Left(str, i)
Exit For
End If
Next
End Function

三、 遍 历 主 函 数 
---- 参 数 说 明: 
strPathName要遍历的目录
objList 使用VB的内部控
件ListBox来存放遍历得到的路径,之所以
不使用字符串数组是因为数组大小不好定义

Public Sub sDirTraversal
(ByVal strPathName As String, ByRef objList As ListBox)
Dim sSubDir(200) As String
'存放当前目录下的子目录,下标可根据需要调整
Dim iIndex As Integer
'子目录数组下标
Dim i As Integer
'用于循环子目录的查找

Dim lHandle As Long 
'FindFirstFileA的句柄
Dim tFindData As WIN32_FIND_DATA '
Dim strFileName As String '文件名

On Error Resume Next
'初始化变量
i = 1
iIndex = 0
tFindData.cFileName =
"" '初始化定长字符串

lHandle = FindFirstFile
(strPathName & "\*.*", tFindData)
If lHandle = 0 Then '查询结束或发生错误
Exit Sub
End If
strFileName = fDelInvaildChr(tFindData.cFileName)
If tFindData.dwFileAttributes = &H10 Then '目录
If strFileName <> "." And strFileName <> ".." Then
iIndex = iIndex + 1
sSubDir(iIndex) = strPathName 
& "\" & strFileName '添加到目录数组
End If
Else
objList.AddItem strPathName
& "\" & strFileName
End If
'循环查找下一个文件,直到结束
Do While True
tFindData.cFileName = ""
If FindNextFile(lHandle, tFindData)
= 0 Then '查询结束或发生错误
FindClose (lHandle)
Exit Do
Else
strFileName = fDelInvaildChr
(tFindData.cFileName)
If tFindData.dwFileAttributes = &H10 Then
If strFileName <> "." And strFileName <> ".." Then
iIndex = iIndex + 1
sSubDir(iIndex) = strPathName
& "\" & strFileName '添加到目录数组
End If
Else
objList.AddItem strPathName & "\" & strFileName
End If
End If
Loop
'如果该目录下有目录,则根据目录数组递归遍历
If iIndex > 0 Then
For i = 1 To iIndex
sDirTraversal sSubDir(i), objList
Next
End If
End Sub

---- 利 用 以 上 遍 历 方 法, 读 者 可 以根 据 数 据 类 型WIN32_FIND_DATA 的dwFileAttributes、ftCreationTime、ftLastAccessTime、ftLastWriteTime 元 素 来 扩充 文 件 查 询 功 能( 按 文 件 属 性、 创 建 日 期、 最 后 修 改 日 期、 最 后 访 问 日 期 等 不 同 条 件 的 查询)。 



完 整 代 码 :

'''''''''''''''''''''''''''''''''''''''''''
'API函数的声明、常量、自定义数据类型
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'API函数的声明
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'最大路径长度和文件属性常量的定义
Public Const MAX_PATH = 260
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100

'自定义数据类型FILETIME和WIN32_FIND_DATA的定义
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'去掉固定长度字符串右边的NULL字符(ASCII值为0)和SPACE字符(ASCII值为32)函数
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function fDelInvaildChr(str As String) As String
On Error Resume Next
For i = Len(str) To 1 Step -1
If Asc(Mid(str, i, 1)) <> 0 And Asc(Mid(str, i, 1)) <> 32 Then
fDelInvaildChr = Left(str, i)
Exit For
End If
Next
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'遍历主函数
'参数说明: 
' strPathName 要遍历的目录
' objList 使用VB的内部控件ListBox来存放遍历得到的路径,之所以
' 不使用字符串数组是因为数组大小不好定义
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub sDirTraversal(ByVal strPathName As String, ByRef objList As ListBox)
Dim sSubDir(200) As String '存放当前目录下的子目录,下标可根据需要调整
Dim iIndex As Integer '子目录数组下标
Dim i As Integer '用于循环子目录的查找

Dim lHandle As Long 'FindFirstFileA 的句柄
Dim tFindData As WIN32_FIND_DATA '
Dim strFileName As String '文件名

On Error Resume Next
'初始化变量
i = 1
iIndex = 0
tFindData.cFileName = "" '初始化定长字符串

lHandle = FindFirstFile(strPathName & "\*.*", tFindData)
If lHandle = 0 Then '查询结束或发生错误
Exit Sub
End If
strFileName = fDelInvaildChr(tFindData.cFileName)
If tFindData.dwFileAttributes = &H10 Then '目录
If strFileName <> "." And strFileName <> ".." Then
iIndex = iIndex + 1
sSubDir(iIndex) = strPathName & "\" & strFileName '添加到目录数组
End If
Else
objList.AddItem strPathName & "\" & strFileName
End If
'循环查找下一个文件,直到结束
Do While True
tFindData.cFileName = ""
If FindNextFile(lHandle, tFindData) = 0 Then '查询结束或发生错误
FindClose (lHandle)
Exit Do
Else
strFileName = fDelInvaildChr(tFindData.cFileName)
If tFindData.dwFileAttributes = &H10 Then
If strFileName <> "." And strFileName <> ".." Then
iIndex = iIndex + 1
sSubDir(iIndex) = strPathName & "\" & strFileName '添加到目录数组
End If
Else
objList.AddItem strPathName & "\" & strFileName
End If
End If
Loop
'如果该目录下有目录,则

#6


Dim ls, ld, l

Private Sub Form_Load()
Set ls = CreateObject("Scripting.FileSystemObject")
End Sub

Private Sub Command1_Click()
'''''''''''''开始查找"E:\"
ListFolder "E:\"
End Sub

''''''''''''''''以下是递规查找
Private Sub ListFolder(ByVal m_strFolder As String)
Set ld = ls.GetFolder(m_strFolder)
StatFolder ld
For Each sld In ld.subFolders
    Debug.Print "文件夹:" & sld
    ListFolder sld
Next
End Sub

Private Sub StatFolder(ByVal m_strFolder As String)
Dim strTemp As String
If m_strFolder <> "" And Right(m_strFolder, 1) <> "\" Then
   m_strFolder = m_strFolder & "\"
End If
Set ld = ls.GetFolder(m_strFolder)
For Each l In ld.Files
    Debug.Print "文件:" & l
Next
End Sub



#1


http://www.csdn.net/Expert/TopicView1.asp?id=798020
这里去看看,里面有我写的一个递归代码

#2


程序是我写的一个文件查找替换小工具软件源程序
有一次我们的IP地址的端口要改动,涉及到网站服务器上所有的页面文件,
将近有10G的文件

所以写了这个程序,如果手工去改的话,一天都改不完,而且还不能保证
没有遗露,用这个东西,半个小时完全搞定,得到领导的赏识,哈,开心的笑啦!

你所要的主要是下面这段代码,用递归的方法,来实现查找多级目录下的文件

自己看看吧,

Private Sub FindFile(Fd As Folder, FileName As String, StrSearch As String)
  Dim sFd As Folder, Fn As File
  Dim RTs As TextStream
  For Each Fn In Fd.Files    '查找当前目录所有文件
     StatusBar1.Panels(1).Text = "请稍候,正在搜索......"
     StatusBar1.Panels(2).Text = Fn.Path
    If (UCase(Fn.Name) Like UCase(FileName)) And Fn.Size > 0 Then
        Set RTs = Fs.OpenTextFile(Fn.Path, ForReading, False, False)
        If InStr(1, Trim(RTs.ReadAll), StrSearch, 1) > 0 Then
      With ListView1
            Index = Index + 1
           .ListItems.Add Index, , Fn.Name
           .ListItems(Index).SubItems(1) = Fn.Size
           .ListItems(Index).SubItems(2) = Fn.Path
           .ListItems(Index).SubItems(3) = Fn.Type
           .ListItems(Index).SubItems(4) = Fn.DateLastModified
      End With
        End If
        RTs.Close
        Set RTs = Nothing
   End If
   DoEvents
   Next
   
  For Each sFd In Fd.SubFolders    '循环查找所有子目录
      FindFile sFd, FileName, StrSearch
  Next
End Sub

#3


程序是我写的一个文件查找替换小工具软件源程序
有一次我们的IP地址的端口要改动,涉及到网站服务器上所有的页面文件,
将近有10G的文件

所以写了这个程序,如果手工去改的话,一天都改不完,而且还不能保证
没有遗露,用这个东西,半个小时完全搞定,得到领导的赏识,哈,开心的笑啦!

你所要的主要是下面这段代码,用递归的方法,来实现查找多级目录下的文件

自己看看吧,

Private Sub FindFile(Fd As Folder, FileName As String, StrSearch As String)
  Dim sFd As Folder, Fn As File
  Dim RTs As TextStream
  For Each Fn In Fd.Files    '查找当前目录所有文件
     StatusBar1.Panels(1).Text = "请稍候,正在搜索......"
     StatusBar1.Panels(2).Text = Fn.Path
    If (UCase(Fn.Name) Like UCase(FileName)) And Fn.Size > 0 Then
        Set RTs = Fs.OpenTextFile(Fn.Path, ForReading, False, False)
        If InStr(1, Trim(RTs.ReadAll), StrSearch, 1) > 0 Then
      With ListView1
            Index = Index + 1
           .ListItems.Add Index, , Fn.Name
           .ListItems(Index).SubItems(1) = Fn.Size
           .ListItems(Index).SubItems(2) = Fn.Path
           .ListItems(Index).SubItems(3) = Fn.Type
           .ListItems(Index).SubItems(4) = Fn.DateLastModified
      End With
        End If
        RTs.Close
        Set RTs = Nothing
   End If
   DoEvents
   Next
   
  For Each sFd In Fd.SubFolders    '循环查找所有子目录
      FindFile sFd, FileName, StrSearch
  Next
End Sub

#4


凭什么告诉你?

#5


如何在VB中实现目录遍历 
一、API 函 数 的 声 明、 自 定 义 数 据 类 型 及 常 量 的 定 义 
---- 注 意:API 函 数 的 声 明应 在 应 用 程 序 的 代 码 模 块 中 进 行, 且 一 条 声 明 必 须 放 在 一 行 中'API 函 数 的 声 明 
Public Declare Function FindFirstFile Lib
"kernel32" Alias "FindFirstFileA" 
(ByVal lpFileName As String, 
lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib
"kernel32" Alias "FindNextFileA" 
(ByVal hFindFile As Long, lpFindFileData
As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib
"kernel32" (ByVal hFindFile As Long) As Long

'最大路径长度和文件属性常量的定义
Public Const MAX_PATH = 260
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100

'自定义数据类型FILETIME和WIN32_FIND_DATA的定义
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

二、 去 掉 固 定 长 度 字 符 串 右 边 的NULL 字 符(ASCII 值 为0) 和SPACE 字符(ASCII 值 为32) 
---- 由 于 数 据 类 型WIN32_FIND_DATA 的cFileName 元 素 为 定 长 数据 类 型 且 在 执 行 函 数FindFirstFile 和FindNextFile 后 会 有NULL 字 符, 因 此 需 去 掉 其 中的 无 效 字 符。 
Public Function fDelInvaildChr
(str As String) As String
On Error Resume Next
For i = Len(str) To 1 Step -1
If Asc(Mid(str, i, 1)) < >
0 And Asc(Mid(str, i, 1)) <> 32 Then
fDelInvaildChr = Left(str, i)
Exit For
End If
Next
End Function

三、 遍 历 主 函 数 
---- 参 数 说 明: 
strPathName要遍历的目录
objList 使用VB的内部控
件ListBox来存放遍历得到的路径,之所以
不使用字符串数组是因为数组大小不好定义

Public Sub sDirTraversal
(ByVal strPathName As String, ByRef objList As ListBox)
Dim sSubDir(200) As String
'存放当前目录下的子目录,下标可根据需要调整
Dim iIndex As Integer
'子目录数组下标
Dim i As Integer
'用于循环子目录的查找

Dim lHandle As Long 
'FindFirstFileA的句柄
Dim tFindData As WIN32_FIND_DATA '
Dim strFileName As String '文件名

On Error Resume Next
'初始化变量
i = 1
iIndex = 0
tFindData.cFileName =
"" '初始化定长字符串

lHandle = FindFirstFile
(strPathName & "\*.*", tFindData)
If lHandle = 0 Then '查询结束或发生错误
Exit Sub
End If
strFileName = fDelInvaildChr(tFindData.cFileName)
If tFindData.dwFileAttributes = &H10 Then '目录
If strFileName <> "." And strFileName <> ".." Then
iIndex = iIndex + 1
sSubDir(iIndex) = strPathName 
& "\" & strFileName '添加到目录数组
End If
Else
objList.AddItem strPathName
& "\" & strFileName
End If
'循环查找下一个文件,直到结束
Do While True
tFindData.cFileName = ""
If FindNextFile(lHandle, tFindData)
= 0 Then '查询结束或发生错误
FindClose (lHandle)
Exit Do
Else
strFileName = fDelInvaildChr
(tFindData.cFileName)
If tFindData.dwFileAttributes = &H10 Then
If strFileName <> "." And strFileName <> ".." Then
iIndex = iIndex + 1
sSubDir(iIndex) = strPathName
& "\" & strFileName '添加到目录数组
End If
Else
objList.AddItem strPathName & "\" & strFileName
End If
End If
Loop
'如果该目录下有目录,则根据目录数组递归遍历
If iIndex > 0 Then
For i = 1 To iIndex
sDirTraversal sSubDir(i), objList
Next
End If
End Sub

---- 利 用 以 上 遍 历 方 法, 读 者 可 以根 据 数 据 类 型WIN32_FIND_DATA 的dwFileAttributes、ftCreationTime、ftLastAccessTime、ftLastWriteTime 元 素 来 扩充 文 件 查 询 功 能( 按 文 件 属 性、 创 建 日 期、 最 后 修 改 日 期、 最 后 访 问 日 期 等 不 同 条 件 的 查询)。 



完 整 代 码 :

'''''''''''''''''''''''''''''''''''''''''''
'API函数的声明、常量、自定义数据类型
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'API函数的声明
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'最大路径长度和文件属性常量的定义
Public Const MAX_PATH = 260
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100

'自定义数据类型FILETIME和WIN32_FIND_DATA的定义
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'去掉固定长度字符串右边的NULL字符(ASCII值为0)和SPACE字符(ASCII值为32)函数
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function fDelInvaildChr(str As String) As String
On Error Resume Next
For i = Len(str) To 1 Step -1
If Asc(Mid(str, i, 1)) <> 0 And Asc(Mid(str, i, 1)) <> 32 Then
fDelInvaildChr = Left(str, i)
Exit For
End If
Next
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'遍历主函数
'参数说明: 
' strPathName 要遍历的目录
' objList 使用VB的内部控件ListBox来存放遍历得到的路径,之所以
' 不使用字符串数组是因为数组大小不好定义
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub sDirTraversal(ByVal strPathName As String, ByRef objList As ListBox)
Dim sSubDir(200) As String '存放当前目录下的子目录,下标可根据需要调整
Dim iIndex As Integer '子目录数组下标
Dim i As Integer '用于循环子目录的查找

Dim lHandle As Long 'FindFirstFileA 的句柄
Dim tFindData As WIN32_FIND_DATA '
Dim strFileName As String '文件名

On Error Resume Next
'初始化变量
i = 1
iIndex = 0
tFindData.cFileName = "" '初始化定长字符串

lHandle = FindFirstFile(strPathName & "\*.*", tFindData)
If lHandle = 0 Then '查询结束或发生错误
Exit Sub
End If
strFileName = fDelInvaildChr(tFindData.cFileName)
If tFindData.dwFileAttributes = &H10 Then '目录
If strFileName <> "." And strFileName <> ".." Then
iIndex = iIndex + 1
sSubDir(iIndex) = strPathName & "\" & strFileName '添加到目录数组
End If
Else
objList.AddItem strPathName & "\" & strFileName
End If
'循环查找下一个文件,直到结束
Do While True
tFindData.cFileName = ""
If FindNextFile(lHandle, tFindData) = 0 Then '查询结束或发生错误
FindClose (lHandle)
Exit Do
Else
strFileName = fDelInvaildChr(tFindData.cFileName)
If tFindData.dwFileAttributes = &H10 Then
If strFileName <> "." And strFileName <> ".." Then
iIndex = iIndex + 1
sSubDir(iIndex) = strPathName & "\" & strFileName '添加到目录数组
End If
Else
objList.AddItem strPathName & "\" & strFileName
End If
End If
Loop
'如果该目录下有目录,则

#6


Dim ls, ld, l

Private Sub Form_Load()
Set ls = CreateObject("Scripting.FileSystemObject")
End Sub

Private Sub Command1_Click()
'''''''''''''开始查找"E:\"
ListFolder "E:\"
End Sub

''''''''''''''''以下是递规查找
Private Sub ListFolder(ByVal m_strFolder As String)
Set ld = ls.GetFolder(m_strFolder)
StatFolder ld
For Each sld In ld.subFolders
    Debug.Print "文件夹:" & sld
    ListFolder sld
Next
End Sub

Private Sub StatFolder(ByVal m_strFolder As String)
Dim strTemp As String
If m_strFolder <> "" And Right(m_strFolder, 1) <> "\" Then
   m_strFolder = m_strFolder & "\"
End If
Set ld = ls.GetFolder(m_strFolder)
For Each l In ld.Files
    Debug.Print "文件:" & l
Next
End Sub