Sub Listfiles(ByVal mydir As String) Dim n As Integer, dirlevel As Integer, fname As String, dirlist() As String, num As Long num = 0 mydir = IIf(Right(mydir, 1) = "\", mydir, mydir & "\") fname = Dir(mydir) Do While fname <> "" Debug.Print mydir & fname num = num + 1 fname = Dir DoEvents Loop fname = LCase(Dir(mydir, vbDirectory)) Do While fname <> "" If fname <> "." And fname <> ".." Then If GetAttr(mydir & fname) And vbDirectory Then dirlevel = dirlevel + 1 ReDim Preserve dirlist(dirlevel) dirlist(dirlevel) = mydir & fname End If End If fname = Dir DoEvents Loop For n = 1 To dirlevel Listfiles dirlist(n) & "\" Next MsgBox "目录 " & mydir & " 共有 " & num & " 个文件" End SubPrivate Sub Command1_Click() Listfiles "f:\rc" End Sub
tztz520(午夜逛街)的只能看见数目~ 不能看见名称~还有文件也看不见~ 谢谢~~这是昨天看过的一个帖子!'模 块 名:GetFolderList '功 能:返回指定文件夹的所有文件夹列表 '返 回 值:成功/失败:True/False '参 数:GetFileList(指定文件夹路径, 文件夹数组) '引 用:无 '外部函数:无 '内部变量:[SearchDir=路径][FoundDir=文件夹名][i=用于循环] '调用方法: '++++++++++++++++++++++++++++++++++++ ' Dim FolderName() As String, i As Long ' GetFileList "c:\", FolderName ‘原帖此处的GetFileList可能是笔误,应该GetFolderList吧 ' For i = 0 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 FolderName(i) = FoundDir '此处有错~~ 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但是用GetFolderList 返回指定文件夹的所有文件夹列表时,会出错~~ 提示函数内的FolderName(i) = FoundDir下标越界~~ (用!!标注处~)
已经用Debug.Print打印出来了,你看一下
改了下。'模 块 名:GetFolderList '功 能:返回指定文件夹的所有文件夹列表 '返 回 值:成功/失败:True/False '参 数:GetFileList(指定文件夹路径, 文件夹数组) '引 用:无 '外部函数:无 '内部变量:[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
Dim n As Integer, dirlevel As Integer, fname As String, dirlist() As String, num As Long
num = 0
mydir = IIf(Right(mydir, 1) = "\", mydir, mydir & "\")
fname = Dir(mydir)
Do While fname <> ""
Debug.Print mydir & fname
num = num + 1
fname = Dir
DoEvents
Loop
fname = LCase(Dir(mydir, vbDirectory))
Do While fname <> ""
If fname <> "." And fname <> ".." Then
If GetAttr(mydir & fname) And vbDirectory Then
dirlevel = dirlevel + 1
ReDim Preserve dirlist(dirlevel)
dirlist(dirlevel) = mydir & fname
End If
End If
fname = Dir
DoEvents
Loop
For n = 1 To dirlevel
Listfiles dirlist(n) & "\"
Next
MsgBox "目录 " & mydir & " 共有 " & num & " 个文件"
End SubPrivate Sub Command1_Click()
Listfiles "f:\rc"
End Sub
参考:
http://blog.csdn.net/lxcc/archive/2004/10/23/148796.aspx
不能看见名称~还有文件也看不见~
谢谢~~这是昨天看过的一个帖子!'模 块 名:GetFolderList
'功 能:返回指定文件夹的所有文件夹列表
'返 回 值:成功/失败:True/False
'参 数:GetFileList(指定文件夹路径, 文件夹数组)
'引 用:无
'外部函数:无
'内部变量:[SearchDir=路径][FoundDir=文件夹名][i=用于循环]
'调用方法:
'++++++++++++++++++++++++++++++++++++
' Dim FolderName() As String, i As Long
' GetFileList "c:\", FolderName ‘原帖此处的GetFileList可能是笔误,应该GetFolderList吧
' For i = 0 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 FolderName(i) = FoundDir '此处有错~~
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但是用GetFolderList
返回指定文件夹的所有文件夹列表时,会出错~~
提示函数内的FolderName(i) = FoundDir下标越界~~ (用!!标注处~)
'功 能:返回指定文件夹的所有文件夹列表
'返 回 值:成功/失败:True/False
'参 数:GetFileList(指定文件夹路径, 文件夹数组)
'引 用:无
'外部函数:无
'内部变量:[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