具有多个目录的文件搜索要搜索

时间:2016-12-10 19:46:56

标签: vba access-vba ms-access-2013 access

我正在使用此语法递归扫描1个目录以查找所有*.mdb | *.accdb文件类型。我的问题是我需要扫描多个目录。我需要扫描

  

C:\测试\   
R:\   
T:\

如何修改以扫描多个目录?

注意
我注释掉下面的代码行,因为我不再需要它作为递归搜索,但不想重写整个过程。

'Set objSubFolders = objFolder.Subfolders
'For Each objSubfolder In objSubFolders
'    RecursiveFileSearch objSubfolder, objRegExp, matchedFiles, objFSO
'Next

代码 - >

Option Compare Database
Sub RefreshLinkedTables()
'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 = ".mdb$|.accdb$"
objRegExp.IgnoreCase = True

Set colFiles = New Collection

RecursiveFileSearch "C:\Test\", objRegExp, colFiles, objFSO

For Each f In colFiles
    Set accapp = New Access.Application
    accapp.OpenCurrentDatabase (f)
    On Error Resume Next
    accapp.Visible = False
    Set db = accapp.CurrentDb
    For Each tdf In db.TableDefs
      If Not (tdf.Name Like "MSys*") Then
        'Relink here
        tdf.RefreshLink
      End If
    Next
    Set tdf = Nothing
    Set db = Nothing
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

修改
根据@Tim Williams的评论 - 我编辑了我的代码,如下所示,但在读取的行

Set objFolder = objFSO.GetFolder(targetFolder)

我收到错误

  

对象变量或未设置块变量

完整的新代码

Option Compare Database
Sub RefreshLinkedTables()
Dim searchdirs() As Variant
Dim sdir As Variant
Dim objFSO As Object
Dim accapp As Access.Application
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim colFiles As Collection

Dim objRegExp As Object
Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Pattern = ".mdb$|.accdb$"
objRegExp.IgnoreCase = True

Set colFiles = New Collection

searchdirs = Array("C:\Test\", "R:\", "T:\")

For Each sdir In searchdirs
    RecursiveFileSearch sdir, objRegExp, colFiles, objFSO

    For Each f In colFiles
        Debug.Print f
    Next

Next

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 objFolder = Nothing
Set objFile = Nothing

End Sub

1 个答案:

答案 0 :(得分:0)

循环遍历文件夹路径数组

Dim v As Variant
For Each v In Array("C:\Test\", "R:\", "T:\")
    RecursiveFileSearch Cstr(v), objRegExp, colFiles, objFSO
Next