给你个……- ' +----------------------------------------------------------------------------+
- ' | 递归查找文件类:可自定义扫描目录层数、文件类型 |
- ' +----------------------------------------------------------------------------+
- 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
复制代码 不要嫌长…… |