搜索选定文件夹及其子文件夹中文件的小工具

好奇心

小花鹿 发表于 2016-1-13 20:58
我试了一下，搜索文件没问题，只是UserForm1.Show 0放的位置不对。

老师：6楼的窗体的第一行字为：“正在搜索文件，请稍候：”，第二行字为："文件搜索完成，共搜索到 24个文件！"，此时，的确文件已经搜索完成，是否修改您的程序，让窗体的第一行字此时也为："文件搜索完成“。建议另设置一个窗体，来实现此目的。谢谢。

小花鹿

好奇心 发表于 2016-1-14 17:35
老师：6楼的窗体的第一行字为：“正在搜索文件，请稍候：”，第二行字为："文件搜索完成，共搜索到 24个 ...

加上一句就行了：
UserForm1.Caption = "文件搜索完成："

好奇心

小花鹿 发表于 2016-1-14 18:55
加上一句就行了：
UserForm1.Caption = "文件搜索完成："

请加入原代码中。谢谢。

小花鹿

好奇心 发表于 2016-1-14 19:18
请加入原代码中。谢谢。

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)
filen = 0
UserForm1.Show 0
For Each myf In Folder.Files
    filen = filen + 1
    FileList(filen, 1) = myf
    UserForm1.Label1.Caption = fileedit(myf)
    DoEvents
Next myf
SubFolderFileList (mypath)
UserForm1.Caption = "文件搜索完成："
UserForm1.Label1.Caption = "文件搜索完成，共搜索到 " & filen & " 个文件！"
DoEvents
If filen > 65536 Then filen = 65536
If filen Then [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
        If myf <> "" Then
            filen = filen + 1
            FileList(filen, 1) = myf
            UserForm1.Label1.Caption = fileedit(myf)
            DoEvents
        End If
    Next myf
    SubFolderFileList (fd.Path)
Next fd
On Error GoTo 0
End Function

Function fileedit(filenam)
Dim file1, file2, filear
If filenam > 60 Then
    filear = Split(filenam, "\")
    file2 = filear(UBound(filear))
    file1 = Replace(filenam, file2, "")
    file1 = Left(file1, 30)
    fileedit = file1 & "...\" & file2
Else
    fileedit = filenam
End If
End Function

lujkhua

JJMY 发表于 2016-1-14 15:27
你的附件在哪呢，谢谢！

已传附件，请看说明

wenwen000424

记录一下，以备不时之需。

zyy19880218

这么简单的问题，竟然要用一百多行代码。