VB用API函数遍历指定驱动器、目录的文件

nDir = 0
ReDim dirNames(nDir)
Cont = True
hSearch = FindFirstFile(path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
DirName = StripNulls(WFD.cFileName)
If (DirName <> ".") And (DirName <> "..") Then
If GetFileAttributes(path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
dirNames(nDir) = DirName
DirCount = DirCount + 1
nDir = nDir + 1
ReDim Preserve dirNames(nDir)
End If
End If
Cont = FindNextFile(hSearch, WFD) 　　获取下一个子目录
Loop
Cont = FindClose(hSearch)
End If

　　 遍历目录并累计文件总数

hSearch = FindFirstFile(path & SearchStr, WFD)
Cont = True
If hSearch <> INVALID_HANDLE_VALUE Then
While Cont
FileName = StripNulls(WFD.cFileName)
If (FileName <> ".") And (FileName <> "..") Then
FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
FileCount = FileCount + 1
List1.AddItem path & FileName
End If
Cont = FindNextFile(hSearch, WFD) 　　 获取下一个文件
Wend
Cont = FindClose(hSearch)
End If

如果子目录存在则遍历之

If nDir > 0 Then
For i = 0 To nDir - 1
FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & "\", _
SearchStr, FileCount, DirCount)
Next i
End If
End Function 

　　查找按钮代码

Sub Command1_Click()
Dim SearchPath As String, FindStr As String
Dim FileSize As Long
Dim NumFiles As Integer, NumDirs As Integer
Dim iNull As Integer, lpIDList As Long, lResult As Long
Dim sPath As String, udtBI As BrowseInfo
With udtBI

　　设置浏览窗口

.hWndOwner = Me.hWnd

返回选中的目录

.ulFlags = BIF_RETURNONLYFSDIRS
End With 

　　调出浏览窗口

lpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
sPath = String$(MAX_PATH, 0)

　　获取路径

SHGetPathFromIDList lpIDList, sPath

　　释放内存

CoTaskMemFree lpIDList
iNull = InStr(sPath, vbNullChar)
If iNull Then
sPath = Left$(sPath, iNull - 1)
End If
End If

Screen.MousePointer = vbHourglass
List1.Clear

SearchPath = sPath 　　选中的目录为搜索的起始路径
FindStr = "*.*" 　　搜索所有类型的文件(此处可另作定义)
FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
Text1.Text = "查找到的文件数：" & NumFiles & vbCrLf & "查找的目录数：" & _
NumDirs + 1 & vbCrLf & "文件大小总共为：" & vbCrLf & _

Format(FileSize, "#,###,###,##0") & "字节"
Screen.MousePointer = vbDefault
End Sub