我正在运行递归文件搜索过程,并且我的计算机关闭了。我知道过程在哪个目录停止,有没有办法为递归文件搜索指定起始文件夹?例如,假设这是我的结构
R:\
R:\Test\
R:\Test\Folder1\
R:\Test1\
R:\Test1\Folder1\
R:\Test2\
R:\Test2\Folder2\
如果我想要递归搜索从
R:\Test1\Folder1\
程序将如何进行?
Option Compare Database
Sub ScanTablesWriteDataToText()
Dim Fileout As Object
Dim fso As Object
Dim objFSO As Object
Dim accapp As Access.Application
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim colFiles As Collection
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objRegExp As Object
Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Pattern = ".jpg"
objRegExp.IgnoreCase = True
Set colFiles = New Collection
RecursiveFileSearch "R:\", objRegExp, colFiles, objFSO
For Each f In colFiles
'do something
Next
Set objFSO = Nothing
Set objRegExp = Nothing
End Sub
Sub RecursiveFileSearch(ByVal targetFolder As String, ByRef objRegExp As Object, _
ByRef matchedFiles As Collection, ByRef objFSO As Object)
Dim objFolder As Object
Dim objFile As Object
Dim objSubFolders As Object
Set objFolder = objFSO.GetFolder(targetFolder)
For Each objFile In objFolder.files
If objRegExp.test(objFile) Then
matchedFiles.Add (objFile)
End If
Next
Set objSubFolders = objFolder.Subfolders
For Each objSubfolder In objSubFolders
RecursiveFileSearch objSubfolder, objRegExp, matchedFiles, objFSO
Next
Set objFolder = Nothing
Set objFile = Nothing
Set objSubFolders = Nothing
End Sub
我将您的递归子项更改为包括两个以上参数-一个用于您要查找的文件夹,另一个用于指示是否已找到的布尔值:
Sub RecursiveFileSearch(ByVal targetFolder As String, ByRef objRegExp As Object, _
ByRef matchedFiles As Collection, ByRef objFSO As Object, _
ByVal startFolder As String, ByVal found As Boolean)
Dim objFolder As Object
Dim objFile As Object
Dim objSubFolders As Object
Set objFolder = objFSO.GetFolder(targetFolder)
If startFolder = "" Or found Then
For Each objFile In objFolder.files
If objRegExp.test(objFile) Then
matchedFiles.Add (objFile)
End If
Next
End If
Set objSubFolders = objFolder.Subfolders
For Each objSubFolder In objSubFolders
If objSubFolder = startFolder Then
found = True
End If
RecursiveFileSearch objSubFolder, objRegExp, matchedFiles, objFSO, _
startFolder, found
Next
Set objFolder = Nothing
Set objFile = Nothing
Set objSubFolders = Nothing
End Sub
当您调用它时,它将是:
RecursiveFileSearch "R:\", objRegExp, colFiles, objFSO, "R:\Test1\Folder1\", false
本文收集自互联网,转载请注明来源。
如有侵权,请联系 [email protected] 删除。
我来说两句