Note that there are some explanatory texts on larger screens.

plurals
  1. POExcel Macro to search folders and return files containing specific keyword and most recent version
    text
    copied!<p>I am looking for some help on writing a macro that will search a folder in my computer to see if any of the files in the folder contain a specified keyword, then return the file name, path and last modified date to an excel worksheet.</p> <pre><code>REF FolderPath REF FileName LastModified FilePath Apple C:\Fruits Kale C:\Vegetables Spinach C:\Vegetables </code></pre> <p>For example (See above),</p> <p>I will have keywords and folder paths in column A and B. The folder called "Fruits" contains a file named "Apple_v5.xls". So I would like the macro to 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 just list out they keywords again in Col A. Macro will also keep going down the list of keywords until it reaches the end.</p> <p>This is what I have so far after researching in the internet, but it didn't work for some reason. Please help! Thanks! </p> <pre><code> 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" &amp; lstRw) For i = 1 To 100 fPath = Sheets("Sheet2").Range("B" &amp; i).Value If Right(fPath, 1) &lt;&gt; "\" Then fPath = fPath &amp; "\" End If fWb = Dir(fPath &amp; "*.*") x = 2 Do While fWb &lt;&gt; "" For Each c In rng If InStr(LCase(fWb), LCase(c.Value)) &gt; 0 Then Worksheets("Sheet2").Range("C" &amp; x) = fWb Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFile(fWb) Worksheets("Sheet2").Range("E" &amp; x) = f.DateLastModified Worksheets("Sheet2").Range("F" &amp; x) = f.Path Worksheets("sheet2").Range("D" &amp; 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 </code></pre>
 

Querying!

 
Guidance

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload