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
'参数:
' 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
我这里没VB
找 "Microsoft Scriping Runtime...."