VB6中遍历所有文件夹的名称

'******************************************************************************
' @(s)
'
' 機能       :データファイルのディレクトリを全て検索する
'
' 返り値     : なし
'
' 引き数     : なし
'
' 備考
'******************************************************************************
Public Function File_Folder_List(ByVal sPath As String) As Integer
    Dim item As String
    Dim Fso As FileSystemObject
    Dim Fol     As Object
    Dim Fil     As Object
    Dim iRet As Integer
    Dim DisFileName     As String
   
    On Error GoTo err_msg
   
    File_Folder_List = -1
   
    If sPath = "" Then
        Exit Function
    End If
     
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Fol = Fso.GetFolder(sPath)

   
    item = Dir(sPath, vbDirectory)
   
    While Len(item) > 0
        If item <> "." And item <> ".." Then
            If (GetAttr(sPath) And vbDirectory) = vbDirectory Then
                If Fol.SubFolders.Count = 0 Then
                  P_szFolders(UBound(P_szFolders)) = sPath
                  ReDim Preserve P_szFolders(UBound(P_szFolders) + 1)
                  Debug.Print sPath
                End If
            End If
        End If
        item = Dir
    Wend
   
    If Fol.SubFolders.Count <> 0 Then
        For Each Fol In Fol.SubFolders
            iRet = File_Folder_List(Fol)
        Next
    End If

    File_Folder_List = 0
    Exit Function
err_msg:
    sPath = ""
    File_Folder_List = -1
End Function