我用FindFirstFile和FindNextFile遍历目录下指定扩展名怎吗不行?

hcaihao 2003-09-12 01:42:35
'遍历主函数
' 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

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

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

lHandle = FindFirstFile(strPathName & "\*.txt", 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 Check4.Value = 1 Then
If iIndex > 0 Then
For i = 1 To iIndex
sDirTraversal sSubDir(i), objList
Next
End If
End If

End Sub

'去掉固定长度字符串右边的NULL字符(ASCII值为0)和SPACE字符(ASCII值为32)函数
Function fDelInvaildChr(str As String) As String
On Error Resume Next
Dim i As Integer
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




上边的
lHandle = FindFirstFile(strPathName & "\*.txt", tFindData)
必须改为
lHandle = FindFirstFile(strPathName & "\*.*", tFindData)
的时候才会显示出子文件夹的内容,为什吗那??谢谢
...全文
172 6 打赏 收藏 转发到动态 举报
写回复
用AI写文章
6 条回复
切换为时间正序
请发表友善的回复…
发表回复
snowolf_ren 2003-11-19
  • 打赏
  • 举报
回复
沒看到 lihonggen0(李洪根,用.NET,标准答案来了) 是用的遞歸算法﹐肯定是可以遍历子文件夹。
xinshou1979330 2003-11-19
  • 打赏
  • 举报
回复
楼主可以试一下啊

hcaihao 2003-09-12
  • 打赏
  • 举报
回复
有API的例子么?上边两个速度很慢的
还有这两个能否控制是否遍历子文件夹?
lihonggen0 2003-09-12
  • 打赏
  • 举报
回复
Private Sub Command1_Click()
Dim ff() As String
Dim fn As Long
Dim i As Long

fn = TreeSearch("c:\windows", "*.txt", ff())

Debug.Print "找到文件数目为" & fn
For i = 1 To fn
Debug.Print ff(i)
Next
End Sub


Private Function TreeSearch(ByVal sPath As String, ByVal sFileSpec As String, sFiles() As String) As Long
Static lngFiles As Long
Dim lngIndex As Long
Dim strDir As String
Dim strSubDirs() As String

If Right(sPath, 1) <> "\" Then
sPath = sPath & "\"
End If

strDir = Dir(sPath & sFileSpec)
Do While Len(strDir)
lngFiles = lngFiles + 1
ReDim Preserve sFiles(1 To lngFiles)
sFiles(lngFiles) = sPath & strDir
strDir = Dir
Loop

lngIndex = 0
strDir = Dir(sPath & "*.*", 16)

Do While Len(strDir)
If Left(strDir, 1) <> "." Then
If GetAttr(sPath & strDir) And vbDirectory Then
lngIndex = lngIndex + 1
ReDim Preserve strSubDirs(1 To lngIndex)
strSubDirs(lngIndex) = sPath & strDir & "\"
End If
End If
strDir = Dir
Loop

For lngIndex = 1 To lngIndex
Call TreeSearch(strSubDirs(lngIndex), sFileSpec, sFiles())
Next lngIndex

TreeSearch = lngFiles
End Function



lihonggen0 2003-09-12
  • 打赏
  • 举报
回复
Microsoft OLE DB Provider for SQL Server 错误 '80040e31'

超时已过期

/Expert/reply.asp,行105
自由之眼 2003-09-12
  • 打赏
  • 举报
回复
给你一个遍历文件夹函数.
通过它你遍历
'±éÀúÎļþ¼Ð
Public Function ScanFile(strLocal As String, strRomates As String, strOriL As String, strOriR As String)
On Error GoTo ine
Dim fso As New FileSystemObject
Dim fol As Folder
Dim fols As Folders
Dim objfile As File
Dim strPath As String
Dim m_strRomate As String

m_strRomate = strRomates
'¿ªÊ¼Ñ­»·¿½±´¶ÔÏó,¿½±´×ÓÎļþ¼ÐÎļþ
Set fol = fso.GetFolder(strLocal)
For Each objfile In fol.Files
Call CopyFile(strLocal + objfile.Name, m_strRomate)
DoEvents
Next

'¼ì²éËùÓÐ×ÓÎļþ¼ÐÖеÄÄÚÈÝ
Set fols = fol.SubFolders
For Each fol In fols
strPath = fol.Path
strPath = Right(strPath, Len(strPath) - Len(strOriL))
strLocal = strOriL + strPath + "\"
m_strRomate = strOriR + strPath + "\"
'µÝ¹éµ÷ÓÃ
Call ScanFile(strLocal, m_strRomate, strOriL, strOriR)
MainFile.laberr.Caption = "ÒÑ¿½±´Îļþ¡¾" & iFcount & "¡¿¸ö"
DoEvents
Next

Set fols = Nothing
Set fol = Nothing
GoTo inerr
ine:
MsgBox Err.Description, , "´íÎóÐÅÏ¢"
inerr:
End Function

7,763

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧