循环遍历子目录，查找文件出错！ 在线等待...

Question

我现在想在“E:\歌曲库”这个文件夹下寻找有没有与我输入的代码相对应的歌曲文件，“E:\歌曲库”这个文件夹下还有好多子类文件夹，比如男歌星，女歌星等等。但在下面的循环遍历文件夹的代码中却出现问题，老是提示找不到对应的文件，其实我输入的文件代码在文件中存在，麻烦各位帮我看看错在哪？我感激不尽，我很急，在线等待，谢谢各位了！！！其中的 sSongNum就是我输入的5位代码，若我输入22720，它对应的的歌曲路径就是“D:\歌曲库\1-男歌星\刘德华\1-原唱\22720-冰雨-刘德华.vox”Dim fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObjectCheckFolder "E:\歌曲库" Sub CheckFolder(strPath As String)
Dim objFolder As Scripting.Folder
Dim objFile As Scripting.File
Dim objSubdirs As Scripting.Folders
Dim objLoopFolder As Scripting.Folder  Set objFolder = fso.GetFolder(strPath) For Each objFile In objFolder.Files
    If Left(objFile.Name,5) = sSongNum Then
       bFound = True
    Else 
       bFound = False
    End If
Next objFileSet objSubdirs = objFolder.SubFolders   
For Each objLoopFolder In objSubdirs
CheckFolder objLoopFolder.Path
Next objLoopFolderSet objSubdirs = Nothing
Set objFolder = Nothing  Dim objAbsPath If bFound = True Then
   objAbsPath = fso.GetAbsolutePathName(objFile.Name)
   sPath = objAbsPath
End If End Sub

Answer 1

'模 块 名：GetFolderList
'功    能：返回指定文件夹的所有文件夹列表
'返 回 值：成功/失败:True/False
'参    数：GetFolderList(指定文件夹路径, 文件夹数组)
'引    用：无
'外部函数：无
'内部变量：[SearchDir=路径][FoundDir=文件夹名][i=用于循环]
'调用方法：
'++++++++++++++++++++++++++++++++++++
'   Dim FolderName() As String, i As Long
'   GetFolderList "C:\", FolderName
'   For i = LBound(FolderName) To UBound(FolderName)
'       Debug.Print FolderName(i)
'   Next i
'++++++++++++++++++++++++++++++++++++
Public Function GetFolderList(ByVal Path As String, ByRef FolderName() As String) As Boolean
    Dim SearchDir As String
    Dim FoundDir As String
    Dim i As Long
    If right(Path, 1) <> "\" Then Path = Path & "\"
    SearchDir = Path & "*."
    FoundDir = Dir(SearchDir, vbDirectory)
    While FoundDir <> ""
        If Not FoundDir = "." Or FoundDir = ".." Then
            ReDim Preserve FolderName(i) As String
            FolderName(i) = FoundDir
        End If
        FoundDir = Dir()
        i = i + 1
    Wend
End Function'模 块 名：GetFileList
'功    能：返回指定文件夹的所有文件名列表
'返 回 值：成功/失败:True/False
'参    数：GetFileList(指定文件夹路径, 文件数组,返回的文件类型)
'引    用：无
'外部函数：无
'内部变量：[fName=文件名][i=用于循环]
'调用方法：
'++++++++++++++++++++++++++++++++++++
'   Dim FileName() As String, i As Long
'   GetFileList "c:\", FileName
'   For i = 0 To UBound(FileName)
'       Debug.Print FileName(i)
'   Next i
'++++++++++++++++++++++++++++++++++++
Function GetFileList(ByVal Path As String, ByRef Filename() As String, Optional fExp As String = "*.*") As Boolean
    Dim fName As String, i As Long
    If right$(Path, 1) <> "\" Then Path = Path & "\"
    fName = Dir$(Path & fExp)
    i = 0
    Do While fName <> ""
        ReDim Preserve Filename(i) As String
        Filename(i) = fName
        fName = Dir$
        i = i + 1
    Loop
    If i <> 0 Then
        ReDim Preserve Filename(i - 1) As String
        GetFileList = True
    Else
        GetFileList = False
    End If
End Function
-----------------------------------
两个函数结合着用，不必用FSO

Answer 2

For Each objFile In objFolder.Files
    If Left(objFile.Name,5) = sSongNum Then
       bFound = True
    Else 
       bFound = False          '----这里出问题了
    End If
Next objFile直接改为bFound = False
For Each objFile In objFolder.Files
    If Left(objFile.Name,5) = sSongNum Then
       bFound = True
    End If
Next objFile

Answer 3

谢谢jjkk168(老加班的人) ，我试试

Answer 4

jjkk168(老加班的人):
改了还是不行啊.....

Answer 5

你的bFound是一个全局变量吧。由于在不等于歌曲文件名的时候就赋值为False，因此还是找不到解决方法
1、将Sub CheckFolder(strPath As String)改为
Function CheckFolder(strPath as string) as boolean如果碰到了需要的结果，CheckFolder=True，再Exit Function2、将bFound变量去除，改为一个Int型变量，CheckFolder入口处设置该Int变量为0，搜索文件，如果找到类似的，这个Int变量就自加1，出口处判断Int变量是否大于0，如果大于0，那么就找到了。

Answer 6

bFound = False
For Each objFile In objFolder.Files
    If InStr(1,objFile.Name,cStr(sSongNum)<>0 Then
       bFound = True
    End If
Next objFile
-------------------------
用InStr加宽条件，好处是，如果你写入的是四位数而你还用Left(objFile.Name,5)就会多出一位。

Answer 7

jjkk168(老加班的人):
这样还是不行.....
我不是在Vb系统下，但用的是Vb的语言，我用的是Senario Editor，做语音系统节目的。

Answer 8

//大家帮忙看看是不是我的程序只能遍历D:\歌曲库这个文件夹下的所有文件，而并没有遍历到其子文件夹，如果要遍历其子文件夹或者更底层的文件夹，应该怎么循环遍历呢？
谢谢！！！你已遍历
//我不是在Vb系统下，但用的是Vb的语言，我用的是Senario Editor，做语音系统节目的。可不可以再加一个公用变量，比如说
public iCount as integer然后再把这个改了
For Each objFile In objFolder.Files
    If Left(objFile.Name,5) = sSongNum Then
       iCount = iCount + 1             '改后的代码
    End If
Next objFile在这以下句前后加上CheckFolder "E:\歌曲库"前加入iCount = 0
后加入
if iCount>0 then
    bFound = True
else
    bFound = False
end if

Answer 9

谢谢jjkk168(老加班的人)，我的想法和你一样，但是我像那样做了之后还是错！
我快郁闷死了！
哪位再帮我看看啊，我真的是绞尽脑汁都想不出错哪了.....我改过的程序是：
Dim fso 
Set fso = CreateObject("Scripting.FileSystemObject")iCount = 0
CheckFolder "E:\歌曲库"  Function CheckFolder(strPath As String)
Dim objFolder As Scripting.Folder
Dim objFile As Scripting.File
Dim objSubdirs As Scripting.Folders
Dim objLoopFolder As Scripting.FolderSet objFolder = fso.GetFolder(strPath) For Each objFile In objFolder.Files
    If Left(objFile.Name,5) = sKey Then
    iCount = iCount + 1
    End If
Next objFileSet objSubdirs = objFolder.SubFolders   
For Each objLoopFolder In objSubdirs
CheckFolder objLoopFolder.Path
Next objLoopFolder Set objSubdirs = Nothing
Set objFolder = NothingEnd FunctionIf iCount > 0 Then
   bFound = True
Else
   bFound = False
End If

Answer 10

转个贴，用API来做。
'Option Explicit'''''''''''''''''''''''''''''''''''''''''''
'API函数的声明、常量、自定义数据类型
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'API函数的声明
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''最大路径长度和文件属性常量的定义
Public Const MAX_PATH = 260
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100'自定义数据类型FILETIME和WIN32_FIND_DATA的定义
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End TypePublic 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''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'去掉固定长度字符串右边的NULL字符(ASCII值为0)和SPACE字符(ASCII值为32)函数
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function fDelInvaildChr(str As String) As String
On Error Resume Next
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''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'遍历主函数
'参数说明:
' 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 '用于循环子目录的查找Dim lHandle As Long 'FindFirstFileA 的句柄
Dim tFindData As WIN32_FIND_DATA '
Dim strFileName As String '文件名On Error Resume Next
'初始化变量
i = 1
iIndex = 0
tFindData.cFileName = "" '初始化定长字符串lHandle = FindFirstFile(strPathName & "\*.*", 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 iIndex > 0 Then
For i = 1 To iIndex
sDirTraversal sSubDir(i), objList
Next
End If
End Sub

Answer 11

终于找到了所要找的文件，可是现在我想得到该文件的具体路径，我用了GetAbsolutePathName 方法来获得具体得路径可是出错了！
我把我做得工程放在“My Documents\yhy\遍历循环找文件\”中，而文件是在E:\歌曲库的文件夹下，我用了GetAbsolutePathName 方法之后，显示的具体路径就为“E:\My Documents\yhy\遍历循环找文件\10042.vox”，其实文件是在“E:\歌曲库\男歌星\原唱\10025.vox”，这个问题怎么解决啊...？？？
怎么才能得到正确的具体路径呢？