做了个搜索文件的代码 大家给点修改建议

小花鹿

为了自己以后用着方便，做了个搜索文件的代码，不知道会存在什么问题，大家给点修改建议：
Option Explicit
Dim FileList(1 To 65536, 1 To 1), filen&

Sub FolderFileList()
'--------------------------------------------------------------------------------------------
Dim myfolder, mypath
    Set myfolder = CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件夹：", 0)
    If Not myfolder Is Nothing Then
        If myfolder <> "桌面" Then mypath = myfolder.Items.Item.Path
    Else
        MsgBox "你没有选择文件夹！"
        Exit Sub
    End If
    If mypath = "" Or Left(mypath, 2) = "::" Then
        MsgBox "文件夹选择错误！"
        Exit Sub
    End If
'------------------------------------------------------------------------------------------------
Dim fso, Folder, myf
Set fso = CreateObject("scripting.filesystemobject")
Set Folder = fso.getfolder(mypath)
For Each myf In Folder.Files
    filen = filen + 1
    FileList(filen, 1) = myf
Next myf
SubFolderFileList (mypath)
If filen > 65536 Then filen = 65536
[a1].Resize(filen) = FileList
filen = 0
End Sub

Function SubFolderFileList(pth)
Dim fso, Folder, SubFolder, myf, fd
Set fso = CreateObject("scripting.filesystemobject")
Set Folder = fso.getfolder(pth)
Set SubFolder = Folder.subfolders
On Error Resume Next
For Each fd In SubFolder
    For Each myf In fd.Files
        filen = filen + 1
        FileList(filen, 1) = myf
    Next myf
    SubFolderFileList (fd.Path)
Next fd
On Error GoTo 0
End Function
把此目录及子目录中的所有xls文件放在此中.rar (15.21 KB, 下载次数: 22)

2016-1-10 11:43 上传

点击文件名下载附件