我想在文件夹中搜索包含指定关键字的文件,然后返回文件名、上次修改日期和 Excel 工作表的路径。
例如
REF FolderPath REF FileName LastModified FilePath
Apple C:\Fruits
Kale C:\Vegetables
Spinach C:\Vegetables
我将在 A 列和 B 列中有关键字和文件夹路径。名为“Fruits”的文件夹包含一个名为“Apple_v5.xls”的文件。我会搜索关键字“Apple”,然后将名称、最新版本和文件路径(Col D、E、F)返回到同一个电子表格。Col C 将再次列出 Col 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