yu2n

给你个……

' +----------------------------------------------------------------------------+
' | 递归查找文件类：可自定义扫描目录层数、文件类型 |
' +----------------------------------------------------------------------------+
Class Scan_Folder
    ' ==============================================================================================================
    ' 类初始化
    ' ==============================================================================================================
    ' 公共变量
    Private fso, regEx, sFolderSpec, sParentFolderLayer, sMaxLayer, sFileType_RegExPatternt, sFileType, sFileList, sFolderList, sEmptyFolderList
    Private Scan_Folder_Only, Scan_Folder_Sub
    '类初始化事件
    Private Sub Class_Initialize
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set regEx = CreateObject("VBScript.RegExp")     ' 建立正则表达式。
            regEx.IgnoreCase = True     ' 设置是否区分大小写。
            regEx.Global = True         ' 设置全局替换。
            regEx.MultiLine = True      ' 设置多行匹配模式
        Scan_Folder_Only = True           ' 仅扫描文件夹(提高效率)
        Scan_Folder_Sub = True            ' 扫描子文件夹
    End Sub
    ' ==============================================================================================================
    ' 获取设定
    ' ==============================================================================================================
    ' 设置扫描目录
    Public Function FolderSpec(ByVal strFolderSpec)
        sFolderSpec = strFolderSpec
    End Function
    ' 设置最大扫描目录层数
    Public Function MaxLayer(ByVal strMaxLayer)
        sMaxLayer = strMaxLayer
    End Function
    ' 设置扫描的文件类型
    Public Function FileType_RegExPatternt(ByVal strFileType_RegExPatternt)
        sFileType_RegExPatternt = strFileType_RegExPatternt
    End Function
    ' 获取文件夹列表(包括空文件夹)
    Public Function GetFolderList()
        Scan_Folder_Only = True
        Scan_Layer sFolderSpec
        GetFolderList = sFolderList
    End Function
    ' 获取空文件夹列表
    Public Function GetEmptyFolderList()
        Scan_Folder_Only = False
        Scan_Layer sFolderSpec
        GetEmptyFolderList = sEmptyFolderList
    End Function
    ' 获取文件列表
    Public Function GetFileList()
        Scan_Folder_Only = False
        Scan_Layer sFolderSpec
        GetFileList = sFileList
    End Function
    ' 关闭控件
    Public Sub Close()
        Set fso = Nothing
        Set regEx = Nothing
    End Sub
    ' ==============================================================================================================
    ' 私有函数
    ' ==============================================================================================================
    ' 递归扫描
    Private Function Scan_Layer(strFolderspec)
        On Error Resume Next
        If Not Right(strFolderspec,1) = "\" Then strFolderspec = strFolderspec & "\"
        If Not IsEmpty(sFolderList) Then sFolderList = sFolderList & vbCrLf
        sFolderList = sFolderList & strFolderspec
        ' 文件夹对象
        Dim oFolder, oSubFolderItems, oSubFileItems, oSubFolder, oSubFile
        Set oFolder = fso.GetFolder(strFolderspec)
        ' 是否扫描 当前文件夹 的 子文件
        If Scan_Folder_Only = False Then
            ' 子文件对象集合
            Set oSubFileItems = oFolder.Files
            ' 查找当前文件夹 的 文件
            If oSubFileItems.Count <> 0 Then
                For Each oSubFile In oSubFileItems
                    If IsEmpty(sFileType_RegExPatternt) Or (sFileType_RegExPatternt = "") Then
                        If Not IsEmpty(sFileList) Then sFileList = sFileList & vbCrLf
                        sFileList = sFileList & oSubFile.Path
                    Else
                        ' 过滤文件类型(适用正则表达式)
                        regEx.Pattern = sFileType_RegExPatternt
                        If regEx.Execute( fso.GetExtensionName(oSubFile) ).Count > 0 Then
                            If Not IsEmpty(sFileList) Then sFileList = sFileList & vbCrLf
                            sFileList = sFileList & oSubFile.Path
                        End If
                    End If
                Next
            End If
        End If
        ' 查找当前文件夹 的 子文件夹
        Set oSubFolderItems = oFolder.SubFolders        ' 子文件夹对象集合
        ' --------没有子文件夹时
        If oSubFolderItems.Count = 0 Then
            ' --------也没有子文件时(此文件夹为空)
            If Scan_Folder_Only = False Then
                If oSubFileItems.Count = 0 Then
                    If Not IsEmpty(sEmptyFolderList) Then sEmptyFolderList = sEmptyFolderList & vbCrLf
                    sEmptyFolderList = sEmptyFolderList & strFolderspec
                End If
            End If
        Else
            ' 限制递归的最大层数
            If Not (IsEmpty(sMaxLayer) Or (sMaxLayer = "")) Then
                Dim s, f, n
                s = Replace(strFolderspec, sFolderSpec, "", vbTextCompare, -1, 1)
                f = "\"
                n = (Len(s)-Len(Replace(s,f,"",vbTextCompare,-1,1)))/Len(f)    ' 统计字符串中某一单词出现次数
                If sMaxLayer < n Then Scan_Folder_Sub = False
            Else
                Scan_Folder_Sub = True
            End If
            If Scan_Folder_Sub = True Then
                ' ----有子文件夹时，递归查找
                For Each oSubFolder In oSubFolderItems
                    'sFolderList = sFolderList & oSubFolder.Path & vbCrLf
                    Scan_Layer oSubFolder.Path
                Next
            End If
        End If
    End Function
End Class
' 实例
Sub Demo(ByVal strFolderPath)
    Dim oScanDir, sFileList, sFolderList
    ' 创建对象
    Set oScanDir = New Scan_Folder
    ' 指定文件夹
    oScanDir.FolderSpec strFolderPath
    ' 设定扫描最大层数(可为空。默认扫描所有子文件夹)
    'oScanDir.MaxLayer 2
    ' 指定文件类型(可为空。正则表达式规则，默认则返回所有文件)
    oScanDir.FileType_RegExPatternt "(jpg|mp4)"
    ' 获取结果(必填。GetFileList返回文件列表，GetFolderList返回目录列表，GetEmptyFolderList返回空目录列表)
    sFileList = oScanDir.GetFileList
    sFolderList = oScanDir.GetFolderList
    ' 结束对象
    oScanDir.Close

    ' 对返回的结果进行操作(这里是获取属性)
    Set fso = CreateObject("Scripting.FileSystemObject")
    arrFilePath = Split(sFileList, vbCrLf, -1, vbTextCompare)
    For i = 0 To UBound(arrFilePath)
        strFilePath = arrFilePath(i)
        WScript.Echo "所在目录: " & fso.GetFile(strFilePath).ParentFolder
        WScript.Echo "名称: " & fso.GetFile(strFilePath).Name
        WScript.Echo "大小: " & fso.GetFile(strFilePath).Size
        WScript.Echo "最后修改时间: " & fso.GetFile(strFilePath).DateLastModified
    Next
End Sub
复制代码

不要嫌长……

yu2n

回复 11# ghost-jason
上面那段是函数，不是程序。如果你在末尾加下面一句，那他就是一个扫描D:的实例程序(请以 CScript.exe  脚本.vbs 的方式运行)：

Call Demo("D:\")
复制代码

如果不是对文件数目很大的目录扫描，可以使用下面的代码（同时也是一个实例程序）：

Dim strPath
strPath = CreateObject("WScript.Shell").ExpandEnvironmentStrings("%USERPROFILE%")
WScript.Echo ScanFolder(strPath)

Function ScanFolder(ByVal strPath)
    Dim arr()
    ReDim Preserve arr(0)
    Call SCAN_FOLDER(arr, strPath)
    ReDim Preserve arr(UBound(arr) - 1)
    ScanFolder = Join(arr, vbCrLf)
End Function
Function SCAN_FOLDER(ByRef arr, ByVal folderSpec)
    On Error Resume Next
    Dim fso, objItems, objFile, objFolder
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objItems = fso.GetFolder(folderSpec)
    If Right(folderSpec, 1) <> "\" Then folderSpec = folderSpec & "\"
    If (Not fso.FolderExists(folderSpec)) Then Exit Function
    For Each objFile In objItems.Files
        arr(UBound(arr)) = objFile.Path
        ReDim Preserve arr(UBound(arr) + 1)
    Next
    For Each objFolder In objItems.subfolders
        Call SCAN_FOLDER(arr, objFolder.Path)
    Next
    arr(UBound(arr)) = folderSpec
    ReDim Preserve arr(UBound(arr) + 1)
End Function
复制代码

yu2n

回复 9# ghost-jason
这段代码不难，如果你要明白这个函数每行语句的意思，直接百度查 vbs fso 就知道了。
我这里重复贴一下，相信你会一目了然：

VBS 文件操作对象FSO大全
http://blog.sina.com.cn/s/blog_611f50100100w7tv.html
复制代码

yu2n

回复 15# ghost-jason

1. 那是【函数】Function（【过程】Sub）的【参数】，也是一种【变量】。
2. 函数自身调用自身，这里是【递归】。要掌握【函数返回值】的运用。

注：符号【】里面的内容必须掌握。

yu2n

回复 20# ghost-jason

函数 ScanFolder(ByVal strPath)
功能：获取指定路径下（参数）所有文件（夹）的路径，保存到一个字符串，函数将返回这个字符串。
使用：例如要知道 D:\ 下面有什么文件（夹）

Dim strPath, strInfo
strPath = "D:\"
strInfo = ScanFolder(strPath)
Msgbox strInfo
复制代码