Excel 请问如何遍历同一个文件夹内的Excel查找相关的内容

请参考:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) <> "B1" Then Exit Sub
    If Target = "" Then Exit Sub
    Dim Fso As Object, File As Object, cnn As Object, rs As Object, rst As Object, SQL$, s$, m&, arr, brr(1 To 1000, 1 To 3), t$
    t = "\" & Target
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set cnn = CreateObject("adodb.connection")
    For Each File In Fso.GetFolder(ThisWorkbook.Path).Files
        If File.Name Like "*.xls*" And InStr(File.Name, ThisWorkbook.Name) = 0 Then
            Set cnn = CreateObject("adodb.connection")
            cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties=excel 12.0;Data Source=" & File
            Set rs = cnn.OpenSchema(20)
            Do Until rs.EOF
                If rs.Fields("TABLE_TYPE") = "TABLE" Then
                    s = Replace(rs("TABLE_NAME").Value, "'", "")
                    If Right(s, 1) = "$" Then
                        SQL = "select * from [" & s & "] where 路径 like '%" & t & "'"
                        Set rst = cnn.Execute(SQL)
                        If Not rst.EOF Then
                            m = m + 1
                            brr(m, 1) = Right$(Split(File.Name, ".")(0), 2) & "月" & Replace(s, "$", "")
                            brr(m, 2) = rst.Fields(0)
                            brr(m, 3) = rst.Fields(1)
                        End If
                    End If
                End If
                rs.MoveNext
            Loop
        End If
    Next
    ActiveSheet.UsedRange.Offset(2).ClearContents
    If m > 0 Then Range("A3").Resize(m, 3) = brr
    rs.Close
    rst.Close
    cnn.Close
    Set rs = Nothing
    Set rst = Nothing
    Set cnn = Nothing
    Set Fso = Nothing
End Sub