VB6.0 获取指定文件夹下的文件[夹]

'说明:获取指定文件夹的子文件夹
'参数:
'   path:字符串,指定的文件夹路径
'   searchOption:布尔值,True 所有子文件夹; False 当前文件夹的子文件夹
'返回值:数组
'注意:数组第1项(GetFolders(0))始终为空,应从第2项(GetFolders(1))开始计算
Public Function GetFolders(path As String, searchOption As Boolean) As String()
    ReDim result(0) As String
    Dim arr() As String
    Dim i, j As Integer
    
    arr = getFolders_(path, searchOption)

    For i = 0 To UBound(arr)
        If arr(i) <> "" Then
            j = j + 1
        End If
    Next
    
    If j > 0 Then '防止下标越界
        ReDim result(j) As String
        j = 1
        For i = 0 To UBound(arr)
            If arr(i) <> "" Then
                result(j) = arr(i)
                j = j + 1
            End If
        Next
    End If
    
    GetFolders = result
End Function

'本函数为私有函数,获取指定文件夹的子文件夹
'因返回的数组可能包含空元素,需由GetFolders进行过滤排除
Private Function getFolders_(path As String, searchOption As Boolean) As String()
    Dim oFso As FileSystemObject '需引用Microsoft Scripting Runtime
    Dim oFolder, oFolder2 As Folder
    Dim i, j As Integer
    Dim list() As String
    ReDim result(0) As String
    
    Set oFso = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFso.GetFolder(path)
    
    '检查文件夹存在
    If Not oFso.FolderExists(path) Then
        getFolders_ = result
        Set oFolder2 = Nothing
        Set oFolder = Nothing
        Set oFso = Nothing
        Exit Function
    End If
    
    '当前文件夹的子文件夹
    If oFolder.SubFolders.Count > 0 Then
        ReDim Preserve result(oFolder.SubFolders.Count - 1)
        For Each oFolder2 In oFolder.SubFolders
            result(i) = oFolder2.path
            i = i + 1
        Next
    End If
    
    '子文件夹的子文件夹
    If searchOption And oFolder.SubFolders.Count > 0 Then
        For Each oFolder2 In oFolder.SubFolders
            list = getFolders_(oFolder2.path, searchOption)
            i = UBound(result)
            ReDim Preserve result(i + UBound(list) + 1)
            For j = 0 To UBound(list)
                result(i + j + 1) = list(j)
            Next
        Next
    End If
    
    getFolders_ = result
    
    Set oFolder2 = Nothing
    Set oFolder = Nothing
    Set oFso = Nothing
End Function

'说明:获取指定文件夹中的文件
'参数:
'   path:字符串,指定的文件夹路径
'   searchOption:布尔值,True 所有文件; False 当前文件夹中的文件
'返回值:数组
'注意:数组第1项(GetFiles(0))始终为空,应从第2项(GetFiles(1))开始计算
Public Function GetFiles(path As String, searchOption As Boolean) As String()
    Dim result() As String
    Dim arr() As String
    Dim i, j As Integer
    
    arr = getFiles_(path, searchOption)
    For i = 0 To UBound(arr)
        If arr(i) <> "" Then
            j = j + 1
        End If
    Next
    If j > 0 Then '防止下标越界
        ReDim result(j) As String
        j = 1
        For i = 0 To UBound(arr)
            If arr(i) <> "" Then
                result(j) = arr(i)
                j = j + 1
            End If
        Next
    End If
    GetFiles = result
End Function

'本函数为私有函数,获取指定文件夹中的文件
'因返回的数组可能包含空元素,需由GetFiles进行过滤排除
Private Function getFiles_(path As String, searchOption As Boolean) As String()
    Dim oFso As FileSystemObject
    Dim oFolder, oFolder2 As Folder
    Dim oFile As File
    Dim i, j As Integer
    Dim list() As String
    ReDim result(0) As String
    
    Set oFso = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFso.GetFolder(path)
    
    '检查文件夹存在
    If Not oFso.FolderExists(path) Then
        getFiles_ = result
        Set oFile = Nothing
        Set oFolder2 = Nothing
        Set oFolder = Nothing
        Set oFso = Nothing
        Exit Function
    End If
    
    '当前文件夹中的文件
    If oFolder.Files.Count > 0 Then
        ReDim Preserve result(oFolder.Files.Count - 1)
        For Each oFile In oFolder.Files
            result(i) = oFile.path
            i = i + 1
        Next
    End If
    
    '子文件夹中的文件
    If searchOption And oFolder.SubFolders.Count > 0 Then
        For Each oFolder2 In oFolder.SubFolders
            list = getFiles_(oFolder2.path, searchOption)
            i = UBound(result)
            ReDim Preserve result(i + UBound(list) + 1)
            For j = 0 To UBound(list)
                result(i + j + 1) = list(j)
            Next
        Next
    End If
    
    getFiles_ = result
    
    Set oFile = Nothing
    Set oFolder2 = Nothing
    Set oFolder = Nothing
    Set oFso = Nothing
End Function


上一篇: VB6.0函数返回数组示例
下一篇: 两只老虎-惠欣版
文章来自: 本站原创
引用通告: 查看所有引用 | 我要引用此文章
Tags:
最新日志:
评论: 0 | 引用: 0 | 查看次数: 5790
发表评论
登录后再发表评论!