利用VB函数Dir()实现递归搜索目录

我在很久以前就实现了这个方法了。它没有采用任何的控件形式，也没有调用系统API函数FindFirst,FindNext进行递归调用，和别人有点不同的就是我用的是VB中的Dir()函数。事实上，直接采用Dir()函数是不能进行自身的递归的调用的，但我们可以采用一种办法把Dir将当前搜索目录的子目录给保存下来，然后在自身的search(strPathName)递归函数中依次进行递归的调用，这样就可以把指定的目录搜索完毕。  
具体代码如下:

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '函数GetExtName '功能:得到文件后缀名(扩展名) '输入:文件名 '输出:文件后缀名(扩展名) ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Function GetExtName(strFileName As String) As String 　Dim strTmp As String 　Dim strByte As String 　Dim i As Long 　For i = Len(strFileName) To 1 Step -1 　　strByte = Mid(strFileName, i, 1) 　　If strByte <> "." Then 　　　strTmp = strByte + strTmp 　　Else 　　　Exit For 　　End If 　Next i 　GetExtName = strTmp End Function Public Function search(ByVal strPath As String, Optional strSearch As String = "") As Boolean 　Dim strFileDir() As String 　Dim strFile As String 　Dim i As Long 　Dim lDirCount As Long 　On Error GoTo MyErr 　If Right(strPath, 1) <> "\" Then strPath = strPath + "\" 　strFile = Dir(strPath, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly) 　While strFile <> "" '搜索当前目录 　DoEvents 　　If (GetAttr(strPath + strFile) And vbDirectory) = vbDirectory Then '如果找到的是目录 　　　If strFile <> "." And strFile <> ".." Then '排除掉父目录(..)和当前目录(.) 　　　　lDirCount = lDirCount + 1 '将目录数增1 　　　　ReDim Preserve strFileDir(lDirCount) As String 　　　　strFileDir(lDirCount - 1) = strFile '用动态数组保存当前目录名  　　　End If 　　Else 　　　If strSearch = "" Then 　　　　Form1.List1.AddItem strPath + strFile 　　　ElseIf LCase(GetExtName(strPath + strFile)) = LCase(GetExtName(strSearch)) Then 　　　　'满足搜索条件，则处理该文件 　　　　Form1.List1.AddItem strPath + strFile '将文件全名保存至列表框List1中 　　　End If 　　End If 　　strFile = Dir 　Wend 　For i = 0 To lDirCount - 1 　　Form1.Label3.Caption = strPath + strFileDir(i) 　　Call search(strPath + strFileDir(i), strSearch) '递归搜索子目录 　Next 　ReDim strFileDir(0) '将动态数组清空 　search = True '搜索成功 　Exit Function MyErr: 　search = False '搜索失败 End Function

转载于:https://www.cnblogs.com/mwming/archive/2012/07/26/2609753.html