最近为一个歌城安装vod系统时，需要找出不同目录的重复歌曲和损坏歌曲文件，这是我编写的2种不使用API列出指定文件夹下所有文件（包含子文件夹）的方法。 两种方法都支持本地磁盘目录(形如: E:\Folder\)和网络共享目录(形如: \\server\Share\)
第一种， 利用Scripting.FileSystemObject对象。此法优点是可以同时得到文件大小和属性，缺点是某些系统目录也可能被列出。请先引用Microsoft Scripting Runtime (%system%\scrrun.dll)
Public Sub SaveFileListOfPath(strFileFullPath As String)
'goodidea 2004/10/02
Dim strFileFullName As String
Dim fso As New Scripting.FileSystemObject '申明并实例化FileSystemObject对象
Dim d As Scripting.Folder
Dim sd As Scripting.Folder
Dim f As Scripting.File
On Error Resume Next
Forms(0).lblStatus.Caption = "正在连接到: " & strFileFullPath
Forms(0).Repaint
Set d = fso.GetFolder(strFileFullPath) '实例化Folder对象
'Debug.Print Err.Number, Err.Description
i = 0
For Each f In d.Files '循环文件夹中每一个文件
If Err.Number = 70 Then Debug.Print "拒绝: ", d.Path
strFileFullName = f.Path
If i >= 10 Then '适当的时候给出一些提示
me.lblStatus.Caption = strFileFullName
me.Repaint
i = 0
End If
i = i + 1
'把文件信息写入到表中， g_cnn是一个公共的ADO.Connection对象
g_cnn.Execute "insert into [tbl_file_list_temp] ([filename],[FullName],[size])" & _
" values(""" & f.Name & """,""" & f.Path & """, " & f.Size & ")"
Next
Set f = Nothing
For Each sd In d.SubFolders '循环每一个子文件夹
Debug.Print sd.Path, sd.Type, sd.Attributes, sd.ShortName
If UCase(sd.ShortName) <> "RECYCLER" Then
Call SaveFileListOfPath(sd.Path) '递归调用，获得文件列表
End If
Next
me.lblStatus.Caption = "总文件个数: " & g_cnn.Execute("select count(*) from [tbl_file_list_temp] ").GetString
me.Repaint
Set fso = Nothing
Set d = Nothing
Set sd = Nothing
End Sub
第二种， 利用Office.FileSearch对象。此法优点是搜索Office文件更加方便，搜索子目录无需递归。请先引用Microsoft Office ojbect Library (%system%\scrrun.dll)
Public Sub SaveFileListOfPath2(strFileFullPath As String)
'goodidea 2004/10/01
Dim strFileFullName As String
Dim objFileSearch As Office.FileSearch
Set objFileSearch = Application.FileSearch '获取FileSearch对象
With objFileSearch
.NewSearch '开始新的搜索
.MatchAllWordForms = True
.SearchSubFolders = True '搜索子目录
.FileType = msoFileTypeAllFiles '搜索的文件类型为所有文件
.LookIn = strFileFullPath '在指定目录中搜索
me.lblStatus.Caption = "正在连接 : " & strFileFullPath
me.Repaint
.Execute msoSortByFileName '执行搜索
For i = .FoundFiles.Count To 1 Step -1 '循环搜索结果
strFileFullName = .FoundFiles(i)
If i Mod 5 = 0 Then '给出提示
me.lblStatus.Caption = strFileFullName
me.Repaint
End If
'把搜索结果写入表中, g_cnn是一个公共的ADO.Connection对象
g_cnn.Execute "insert into [tbl_file_list_temp] ([filename],[FullName])" & _
" values(""" & gf_getFileNameOfFullName(strFileFullName) & """,""" & strFileFullName & """)"
Next
End With
me.lblStatus.Caption = "总文件个数: " & g_cnn.Execute("select count(*) from [tbl_file_list_temp] ").GetString
me.Repaint
Set objFileSearch = Nothing
End Sub
