vba 搜索文件夹并返回包含特定关键字和最新版本的文件
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/17220505/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Search folders and return files containing specific keyword and most recent version
提问by Futochan
I want to search a folder for files that contain a specified keyword, then return the file name, last modified date and path to an Excel worksheet.
我想在文件夹中搜索包含指定关键字的文件，然后返回文件名、上次修改日期和 Excel 工作表的路径。
For example
例如
REF FolderPath REF FileName LastModified FilePath
Apple C:\Fruits
Kale C:\Vegetables
Spinach C:\Vegetables
I will have keywords and folder paths in column A and B. The folder called "Fruits" contains a file named "Apple_v5.xls". I would search for the keyword "Apple", then return the name, most recent version and file path (Col D, E, F) to the same spreadsheet. Col C will list the keywords again in Col A. Macro will also keep going down the list of keywords until it reaches the end.
我将在 A 列和 B 列中包含关键字和文件夹路径。名为“Fruits”的文件夹包含一个名为“Apple_v5.xls”的文件。我会搜索关键字“Apple”，然后将名称、最新版本和文件路径（Col D、E、F）返回到同一个电子表格。Col C 将在 Col A 中再次列出关键字。宏也将继续沿关键字列表向下移动，直到到达末尾。
This is what I have so far.
这是我到目前为止。
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
回答by Jaycal
You've got a few issues with some of the code/layout here. Without essentially re-writing most of the macro for you, here's the approach you can use.
此处的某些代码/布局存在一些问题。无需为您重新编写大部分宏，这里是您可以使用的方法。
---Obtain the range of cells that have your keyword (you do this already with your rng)
---获取包含您的关键字的单元格范围（您已经使用您的rng）
---Set your row counter (you already use the xvariable to do this)
---设置您的行计数器（您已经使用该x变量来执行此操作）
---Loop through each cell in the range (you do this already using the for each c in rngcode)
---循环遍历范围内的每个单元格（您已经使用for each c in rng代码执行此操作）
Then within that loop...
然后在那个循环中......
---Get the filepath from the B column (you do this already when you set your fPathvariable)
---从 B 列获取文件路径（您在设置fPath变量时已经这样做了）
---Search the folder for the first file with the keyword using the following code
---使用以下代码在文件夹中搜索带有关键字的第一个文件
fwb = Dir(fPath & c.Value & ".*")
This takes your REF value and inserts it in the directory path. the * in ".*" states that you want it to return any file type (e.g. Apple.txt, Apple.pdf, Apple.mp3)
这将获取您的 REF 值并将其插入到目录路径中。“.*”中的 * 表示您希望它返回任何文件类型（例如 Apple.txt、Apple.pdf、Apple.mp3）
-- If the file was found, then populate the date last modified, path, name of file, and hyperlink (all of which you know how to do already as indicated by the rest of the code)
-- 如果找到文件，则填充上次修改日期、路径、文件名和超链接（所有这些你都知道如何做，如其余代码所示）
-- Reset your file and filesystemobject variables (fand fs)
-- 重置您的文件和文件系统对象变量（f和fs）
Finally, outside of your loop, you can reset your other variables (i.e. sh, rng) Hopefully this helps.
最后，在循环之外，您可以重置其他变量（即sh, rng），希望这会有所帮助。
