tmpStrg = Dir$(App.Path & "\mp3\*.mp3") 'Look for mp3 files (If you want to change to any other type, ' just replace *.mp3 with another extension (E.g *.bmp) If tmpStrg <> "" Then 'have mp3s in the directory If ShowExtension = False Then 'They don't want extension mp3FileName = Left$(tmpStrg, Len(tmpStrg) - 4) 'Take four of the left because 'If you don't the file extenstion ( 4 because .mp3 That's four letters right?) Else 'They want extension mp3FileName = tmpStrg End If lstMusic.AddItem mp3FileName 'Add the mp3's to the list box tmpStrg = Dir$ 'Go back to the directory to add more mp3s While Len(tmpStrg) > 0 'While there is still more unadded mp3s If ShowExtension = False Then 'They don't want extension mp3FileName = Left$(tmpStrg, Len(tmpStrg) - 4) 'Take off the .mp3 Else 'They want extension mp3FileName = tmpStrg End If lstMusic.AddItem mp3FileName 'Add the mp3 tmpStrg = Dir$ 'Go back to the directory to add more mp3s Wend Else 'There isn't any mp3's in the directory MsgBox "You need to put mp3s in the folder " & Chr(13) & App.Path & "\mp3", vbExclamation, "Need mp3 files" End If
查找文件新建一个工程,放四个text,一个command,一个list,使用默认名称。 将下以下代码贴入 Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As LongConst MAX_PATH = 260 Const MAXDWORD = &HFFFF Const INVALID_HANDLE_VALUE = -1 Const FILE_ATTRIBUTE_ARCHIVE = &H20 Const FILE_ATTRIBUTE_DIRECTORY = &H10 Const FILE_ATTRIBUTE_HIDDEN = &H2 Const FILE_ATTRIBUTE_NORMAL = &H80 Const FILE_ATTRIBUTE_READONLY = &H1 Const FILE_ATTRIBUTE_SYSTEM = &H4 Const FILE_ATTRIBUTE_TEMPORARY = &H100Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End TypePrivate 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 Function StripNulls(OriginalStr As String) As String If (InStr(OriginalStr, Chr(0)) > 0) Then OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1) End If StripNulls = OriginalStr End FunctionFunction FindFilesAPI(path As String, SearchStr As String, FileCount As Integer, DirCount As Integer) Dim FileName As String Dim DirName As String Dim dirNames() As String Dim nDir As Integer Dim i As Integer Dim hSearch As Long Dim WFD As WIN32_FIND_DATA Dim Cont As Integer If Right(path, 1) <> "\" Then path = path & "\"
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) ' Get next file 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 FunctionPrivate Sub Command1_Click() Dim SearchPath As String, FindStr As String Dim FileSize As Long Dim NumFiles As Integer, NumDirs As Integer Screen.MousePointer = vbHourglass List1.Clear SearchPath = Text1.Text FindStr = Text2.Text FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs) Text3.Text = NumFiles & " Files found in " & NumDirs + 1 & " Directories" Text4.Text = "Size of files found under " & SearchPath & " = " & Format(FileSize, "#,###,###,##0") & " Bytes" Screen.MousePointer = vbDefault End Sub 在text1中输入目录,text2中输入想要查找的文件类型,按下command .....文件夹 Public Sub ShowFloder(strDir As String, objDir As Object) On Error Resume Next Dim lngCount As Long Dim i As Long Dim strPath As String
With objDir .Path = strDir lngCount = .ListCount For i = 0 To lngCount - 1 .Path = strDir
strPath = .List(i) ''取得当前子目录
'获得一个目录字符串
Call ShowFloder(strPath, objDir) ''递归寻找 Next End With End Sub
' just replace *.mp3 with another extension (E.g *.bmp)
If tmpStrg <> "" Then 'have mp3s in the directory
If ShowExtension = False Then 'They don't want extension
mp3FileName = Left$(tmpStrg, Len(tmpStrg) - 4) 'Take four of the left because
'If you don't the file extenstion ( 4 because .mp3 That's four letters right?)
Else 'They want extension
mp3FileName = tmpStrg
End If
lstMusic.AddItem mp3FileName 'Add the mp3's to the list box
tmpStrg = Dir$ 'Go back to the directory to add more mp3s
While Len(tmpStrg) > 0 'While there is still more unadded mp3s
If ShowExtension = False Then 'They don't want extension
mp3FileName = Left$(tmpStrg, Len(tmpStrg) - 4) 'Take off the .mp3
Else 'They want extension
mp3FileName = tmpStrg
End If
lstMusic.AddItem mp3FileName 'Add the mp3
tmpStrg = Dir$ 'Go back to the directory to add more mp3s
Wend
Else 'There isn't any mp3's in the directory
MsgBox "You need to put mp3s in the folder " & Chr(13) & App.Path & "\mp3", vbExclamation, "Need mp3 files"
End If
将下以下代码贴入
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As LongConst MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End TypePrivate 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
Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End FunctionFunction FindFilesAPI(path As String, SearchStr As String, FileCount As Integer, DirCount As Integer) Dim FileName As String
Dim DirName As String
Dim dirNames() As String
Dim nDir As Integer
Dim i As Integer
Dim hSearch As Long
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
If Right(path, 1) <> "\" Then path = path & "\"
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) ' Get next file
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 FunctionPrivate Sub Command1_Click()
Dim SearchPath As String, FindStr As String
Dim FileSize As Long
Dim NumFiles As Integer, NumDirs As Integer
Screen.MousePointer = vbHourglass
List1.Clear
SearchPath = Text1.Text
FindStr = Text2.Text
FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
Text3.Text = NumFiles & " Files found in " & NumDirs + 1 & " Directories"
Text4.Text = "Size of files found under " & SearchPath & " = " & Format(FileSize, "#,###,###,##0") & " Bytes"
Screen.MousePointer = vbDefault
End Sub
在text1中输入目录,text2中输入想要查找的文件类型,按下command .....文件夹
Public Sub ShowFloder(strDir As String, objDir As Object)
On Error Resume Next
Dim lngCount As Long
Dim i As Long
Dim strPath As String
With objDir
.Path = strDir
lngCount = .ListCount
For i = 0 To lngCount - 1
.Path = strDir
strPath = .List(i) ''取得当前子目录
'获得一个目录字符串
Call ShowFloder(strPath, objDir) ''递归寻找
Next
End With
End Sub