标题: VB6.0 获取指定文件夹下的文件[夹]
作者: dnawo
日期: 2009-09-30 11:38 PM
分类: Win编程
内容: 复制内容到剪贴板 程序代码'说明：获取指定文件夹的子文件夹
'参数：
' 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
+ 查看当前日志评论 (0)
────────────
PJBlog3 v3.2.9.518 Inside.
Processed In 0.063 ms
你没有权限发表评论
────────────
PJBlog3 v3.2.9.518 Inside.
Processed In 0.063 ms
暂无评论
────────────
PJBlog3 v3.2.9.518 Inside.
Processed In 0.063 ms