搜索字符串/单词，文件名并使用fso提取到新表中

1）FSO具有一些很棒的功能。其中之一是.Name。在这条线之后：

For Each File In Folder.Files

写：

Debug.Print File.Name

在立即的窗口中，您将看到文件的名称。然后，您可以通过简单的引用将结果复制到工作表中，如下所示：

wks.Range("E1").Value = File.Name

标头只是将这一行修改为：

.Range("A1:D1") = Array("Test", "Temp", "Start", "Type")

2）要搜索最快最简单的单词，就是使用like函数。同样，您将使用与以前相同的方法，但使用一条If语句。

If File.Name Like "*SomeString*" Then
    wksFSO.Cells(1, 1) = File.Name
End If

请注意在*sear字符串之前和之后使用通配符。随意修改它。很明显，我的结果指向单个单元格。如果期望很多，则可以更新它以在期望更多结果的情况下写入新行。要将它们提取到新的文件中，Worksheet我先设置Worksheet和复制名称。像这样：

Worksheets.Add

现在将所有内容包装到相同的代码中，可以这样编写：

Option Explicit

Sub ScanFiles()

    Application.ScreenUpdating = False

    Dim wks As Worksheet
    Set wks = Worksheets.Add
    wks.Name = "NewWorksheet"

    ' New worksheet for question 2
    Dim wksFSO As Worksheet
    Set wksFSO = Worksheets.Add
    wksFSO.Name = "FSOWorksheet"

    ' Add headers data
    With wks
        .Range("A1:E1") = Array("Test", "Temp", "Start", "Type", "FileName")
    End With

    ' Set your copy ranges
    Dim CopyRange(1 To 4) As String
    CopyRange(1) = "A18"
    CopyRange(2) = "A19"
    CopyRange(3) = "A14"
    CopyRange(4) = "A19"

    ' Early Binding - Add "Microsoft Scripting Runtime" Reference
    Dim FSO As New Scripting.FileSystemObject

    ' Set FolderPath
    Dim FolderPath As String
    FolderPath = "c:\Users\Desktop\Tryout\"

    ' Set Folder FSO
    Dim Folder As Scripting.Folder
    Set Folder = FSO.GetFolder(FolderPath)

    ' Loop thru each file -> Assuming only 6 files
    Dim File As Scripting.File
    For Each File In Folder.Files

        ' If loop looking for specific files and copy to new FSOWorksheet
        If File.Name Like "*SomeString*" Then
            wksFSO.Cells(1, 1) = File.Name
        End If

        Dim wkbData As Workbook
        Set wkbData = Workbooks.Open(File.Path)

        Dim wksData As Worksheet
        Set wksData = wkbData.Worksheets("Sheet1") ' -> Assume this file has only 1 worksheet

        Dim BlankRow As Long
        BlankRow = wks.Range("A" & wks.Rows.Count).End(xlUp).row + 1

        Dim i As Long
        For i = 1 To 4
            wks.Cells(BlankRow, i).Value = wksData.Range(CopyRange(i)).Value
        Next i

        ' Write filename in col E
        wks.Cells(BlankRow, 5).Value = File.Name

        wkbData.Close False

    Next File

    Range("A:I").EntireColumn.AutoFit
    Application.ScreenUpdating = True

End Sub