Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6
Private StopFlag As Boolean
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As LongPublic Sub FileSearch(ByVal sPath As String, ByVal Filter As String)
Static lngFiles As Long
Dim sDir As String
Dim sSubDirs() As String
Dim lngIndex As Long
Dim lngTemp&
Dim sFilter() As String
Dim lngFilterIndex As Long
Dim bDirFlags As Boolean
sFilter = Split(Filter, ",")
DoEvents
If StopFlag = True Then Exit Sub
Label1.Caption = "当前路径" & sPath
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
For lngFilterIndex = LBound(sFilter) To UBound(sFilter)
sDir = Dir(sPath & sFilter(lngFilterIndex))
Do While Len(sDir)
lngFiles = lngFiles + 1
Text1.Text = sPath & sDir
sDir = Dir
Loop
Next
lngIndex = 0
sDir = Dir(sPath & "*.*", vbDirectory)
Do While Len(sDir)
If Left(sDir, 1) <> "." And Left(sDir, 1) <> ".." Then
On Error Resume Next
bDirFlags = False
bDirFlags = GetAttr(sPath & sDir) And vbDirectory
If bDirFlags = True Then
lngIndex = lngIndex + 1
ReDim Preserve sSubDirs(1 To lngIndex)
sSubDirs(lngIndex) = sPath & sDir & "\"
DoEvents
End If
On Error GoTo 0
End If
sDir = Dir
Loop
For lngTemp = 1 To lngIndex
Call FileSearch(sSubDirs(lngTemp), Filter)
Next lngTemp
End Sub
Public Sub StartSearch(ByVal Filter As String)
Dim nType As Long, s As String, sDrive As String, d As String
Dim pos As Integer
s = String(256, Chr(0))
GetLogicalDriveStrings Len(s), s
Do
pos = InStr(s, Chr(0))
sDrive = Left(s, pos - 1)
If Len(sDrive) = 0 Then Exit Do
s = Mid(s, pos + 1)
nType = GetDriveType(sDrive)
If nType = DRIVE_FIXED Then
d = Left(sDrive, 2) & "\"
FileSearch d, Filter
End If
Loop Until pos <= 0
End Sub
Private Sub Command1_Click()   '测试StartSearch "qq.exe"End Sub为什么在xp下就可以运行 在win7下就实时报错VBWindows XPWindows 7