Excel 搜索文件夹并返回包含特定关键字和最新版本的文件

我想在文件夹中搜索包含指定关键字的文件，然后返回Excel工作表的文件名、上次修改日期和路径

比如说

REF     FolderPath      REF   FileName   LastModified   FilePath  
Apple   C:\Fruits           
Kale    C:\Vegetables           
Spinach C:\Vegetables           

我将在A列和B列中列出关键字和文件夹路径。名为“Fruits”的文件夹包含一个名为“Apple_v5.xls”的文件。我会搜索关键字“Apple”，然后将名称、最新版本和文件路径（cold、E、F）返回到同一个电子表格中。C列将在A列中再次列出关键字。宏还将继续向下搜索关键字列表，直到到达末尾

这就是我目前所拥有的

Private Sub CommandButton1_Click()

    Dim sh As Worksheet, rng As Range, lr As Long, fPath As String
    Set sh = Sheets("Sheet2")
    lstRw = sh.Cells.Find(What:="*", After:=sh.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious,                 MatchCase:=False).Row
    Set rng = sh.Range("A2:A" & lstRw)

    For i = 1 To 100

        fPath = Sheets("Sheet2").Range("B" & i).Value

        If Right(fPath, 1) <> "\" Then
            fPath = fPath & "\"
        End If

        fWb = Dir(fPath & "*.*")
        x = 2
        Do While fWb <> ""
            For Each c In rng
                If InStr(LCase(fWb), LCase(c.Value)) > 0 Then
                    Worksheets("Sheet2").Range("C" & x) = fWb
                    Set fs = CreateObject("Scripting.FileSystemObject")
                    Set f = fs.GetFile(fWb)
                    Worksheets("Sheet2").Range("E" & x) = f.DateLastModified
                    Worksheets("Sheet2").Range("F" & x) = f.Path
                    Worksheets("sheet2").Range("D" & x) = c.Value
                    Worksheets("sheet2").Hyperlinks.Add Anchor:=Worksheets("sheet2").Cells(x, 2), Address:=f.Path
                    Columns("A:D").AutoFit
                    Set fs = Nothing
                    Set f = Nothing
                    x = x + 1
                End If
            Next
            fWb = Dir
        Loop
        Set sh = Nothing
        Set rng = Nothing

    Next i

    Sheets("Sheet2").Activate

End Sub

Private子命令按钮1\u单击（）
将sh作为工作表，rng作为范围，lr作为长度，fPath作为字符串
设置sh=板材（“板材2”）
lstRw=sh.Cells.Find（What:=“*”，After:=sh.Range（“A1”），LookAt:=xlPart，LookIn:=xlFormulas，SearchOrder:=xlByRows，SearchDirection:=xlPrevious，MatchCase:=False）。行
设置rng=sh.Range（“A2:A”和lstRw）
对于i=1到100
fPath=板材（“板材2”）.范围（“B”和i）.值
如果正确（fPath，1）“\”则
fPath=fPath&“\”
如果结束
fWb=Dir（fPath&“***”）
x=2
当fWb“”时执行此操作
对于rng中的每个c
如果仪表（LCase（fWb）、LCase（c.值））大于0，则
工作表（“表2”）。范围（“C”和x）=fWb
设置fs=CreateObject（“Scripting.FileSystemObject”）
Set f=fs.GetFile（fWb）
工作表（“表2”）。范围（“E”和x）=f.DateLastModified
工作表（“表2”）.范围（“F”&x）=F.路径
工作表（“表2”）。范围（“D”和x）=c.值
工作表（“sheet2”）。超链接。添加锚定：=工作表（“sheet2”）。单元格（x，2），地址：=f.Path
列（“A:D”）。自动拟合
设置fs=Nothing
设置f=无
x=x+1
如果结束
下一个
fWb=Dir
环
设置sh=无
设置rng=无
接下来我
工作表（“工作表2”）。激活
端接头

这里的一些代码/布局有一些问题。无需为您重新编写大部分宏，以下是您可以使用的方法

---获取包含关键字的单元格范围（您已经使用

rng

）

---设置行计数器（您已经使用

x

变量执行此操作）

---循环遍历范围内的每个单元格（已使用rng中每个c的

代码执行此操作）

然后在这个循环中

---从B列中获取文件路径（在设置
fPath
变量时已经这样做了）

---使用以下代码在文件夹中搜索带有关键字的第一个文件

fwb = Dir(fPath & c.Value & ".*")

这将获取REF值并将其插入目录路径中。“*”中的*表示您希望它返回任何文件类型（例如Apple.txt、Apple.pdf、Apple.mp3）

--如果找到该文件，则填充上次修改的日期、路径、文件名和超链接（所有这些您都知道如何执行，如代码的其余部分所示）

--重置文件和文件系统对象变量（
f
和
fs
）

最后，在循环之外，您可以重置其他变量（即
sh
，
rng
），希望这会有所帮助。
我做了上述更改，但没有成功。现在它只是抓取文件夹中的所有文件并忽略我的关键字。你知道为什么会发生这种情况吗？我重写了我的答案，因为需要的不仅仅是我以前提供的更新。编辑后的答案将涵盖所有内容